Vergleich von Methoden zur Veränderungsklassifikation in simulierten Fragebogen-Daten für verschiedene Messzeitpunkt-Intervalle:
“PP_5.5” besteht aus je 5 Messzeitpunkten im Pre- und im Post-Intervall. Dies sind die ursprünglich simulierten Fragebogen-Daten von N = 8226 Personen (ursprünglich N = 100.000).
“PP_30.30” besteht aus je 30 Messzeitpunkten im Pre- und im Post-Intervall. Diese wurden aus den ursprünglichen Simulationsdaten erweitert und umfassen dieselben N = 8226 Personen.
“PP_1.1” besteht jeweils aus dem 1. Messzeitpunkt im Pre- und im Post-Intervall für jede einzelne Person (N = 8226).
# Ausschluss von Personen ohne Varianz in min. einem MZP-Intervall
PP_5.5 = PP_5.5 %>%
filter(ind.pretestSD != 0 & ind.posttestSD != 0)
PP_30.30 = PP_30.30 %>%
filter(ind.pretestSD != 0 & ind.posttestSD != 0)
PP_5.5 = PP_5.5 %>%
filter(ID_orig %in% PP_30.30$ID1_PRE)
PP_30.30 = PP_30.30 %>%
filter(ID1_PRE %in% PP_5.5$ID_orig)
PP_1.1 = PP_1.1 %>%
filter(ID_orig %in% PP_5.5$ID_orig & ID_orig %in% PP_30.30$ID1_PRE)
PP_5.5 = PP_5.5 %>%
add_column(., .before = "ID_orig", ID = 1:nrow(.))
PP_30.30 = PP_30.30 %>%
add_column(., .before = "ID1_PRE", ID = 1:nrow(.))
PP_1.1 = PP_1.1 %>%
add_column(., .before = "ID_orig", ID = 1:nrow(.))Beispiel-Verläufe in den 3 untersuchten Datensets
PP_5.5 %>%
within(., {ind.pretestSD = round(ind.pretestSD, digits = 2)
ind.posttestSD = round(ind.posttestSD, digits = 2)}) %>%
head() %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
scroll_box(width = "100%")| ID | ID_orig | PRE1_1 | PRE1_2 | PRE1_3 | PRE1_4 | PRE1_5 | POST1_1 | POST1_2 | POST1_3 | POST1_4 | POST1_5 | PRE_Mean | POST_Mean | MeanDiff | ind.pretestSD | ind.posttestSD |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | 1 | 8 | 7 | 11 | 8 | 7 | 1 | 2 | 1 | 4 | 7 | 8.2 | 3.0 | 5.2 | 1.64 | 2.55 |
| 2 | 2 | 9 | 10 | 11 | 11 | 11 | 13 | 13 | 8 | 12 | 6 | 10.4 | 10.4 | 0.0 | 0.89 | 3.21 |
| 3 | 3 | 8 | 8 | 10 | 11 | 8 | 1 | 2 | 3 | 2 | 2 | 9.0 | 2.0 | 7.0 | 1.41 | 0.71 |
| 4 | 4 | 10 | 7 | 8 | 5 | 6 | 6 | 5 | 4 | 3 | 1 | 7.2 | 3.8 | 3.4 | 1.92 | 1.92 |
| 5 | 5 | 9 | 6 | 4 | 7 | 9 | 6 | 6 | 7 | 4 | 9 | 7.0 | 6.4 | 0.6 | 2.12 | 1.82 |
| 6 | 6 | 12 | 13 | 11 | 10 | 19 | 11 | 10 | 7 | 7 | 6 | 13.0 | 8.2 | 4.8 | 3.54 | 2.17 |
Pre-Post-Verläufe für 9 zufällig gezogene Personen
rand = sample(PP_5.5$ID, 9)
x = tibble(ID = c(rep(rand[1],times=11),
rep(rand[2],times=11),
rep(rand[3],times=11),
rep(rand[4],times=11),
rep(rand[5],times=11),
rep(rand[6],times=11),
rep(rand[7],times=11),
rep(rand[8],times=11),
rep(rand[9],times=11)),
MZP = rep(seq(as.Date("2020-01-01"), length.out=11, by="1 day"), times=9),
Score = c(as.numeric(PP_5.5[rand[1],pre_5mzp]), NA, as.numeric(PP_5.5[rand[1],post_5mzp]),
as.numeric(PP_5.5[rand[2],pre_5mzp]), NA, as.numeric(PP_5.5[rand[2],post_5mzp]),
as.numeric(PP_5.5[rand[3],pre_5mzp]), NA, as.numeric(PP_5.5[rand[3],post_5mzp]),
as.numeric(PP_5.5[rand[4],pre_5mzp]), NA, as.numeric(PP_5.5[rand[4],post_5mzp]),
as.numeric(PP_5.5[rand[5],pre_5mzp]), NA, as.numeric(PP_5.5[rand[5],post_5mzp]),
as.numeric(PP_5.5[rand[6],pre_5mzp]), NA, as.numeric(PP_5.5[rand[6],post_5mzp]),
as.numeric(PP_5.5[rand[7],pre_5mzp]), NA, as.numeric(PP_5.5[rand[7],post_5mzp]),
as.numeric(PP_5.5[rand[8],pre_5mzp]), NA, as.numeric(PP_5.5[rand[8],post_5mzp]),
as.numeric(PP_5.5[rand[9],pre_5mzp]), NA, as.numeric(PP_5.5[rand[9],post_5mzp])))
x %>%
group_by(ID) %>%
plot_time_series(MZP, Score,
#.color_var = ID, # for multiple lines in one plot
#.color_lab = "ID",
.facet_ncol = 3,
.facet_scales = "fixed",
.interactive = TRUE,
.facet_collapse = FALSE,
.smooth = TRUE,
.smooth_degree = 2,
.smooth_alpha = 0.5,
.smooth_size = 0.2
)# don´t run this section (code for extremely computation-intense plots that I already stored as .RData and .jpg)
# repeated-measures scatter-boxplot-violin-histograms for individual PRE and POST means
# from van Langen (2020) Open-visualizations tutorial for repeated measures in R
# PP_5.5
# converting my dataframes to use in the same ggplot structure:
PP_5.5_ts = PP_5.5 %>%
select(ID, PRE_Mean, POST_Mean) %>%
pivot_longer(!ID, names_to = "Interval", values_to = "Mean") %>%
mutate(ID = as.factor(ID),
Interval = rep(c(1,2), times = nrow(PP_5.5)))
save(PP_5.5_ts, file = "Time Series Dataframes/k20_PP_5.5_ts.RData")
###
load("Time Series Dataframes/k20_PP_5.5_ts.RData")
# Repeated measures with box− and violin plots
PP_5.5_ts$jit = jitter(PP_5.5_ts$Interval, amount = .09)
Pre_Post_Box_Violin = ggplot(data = PP_5.5_ts, aes(y = Mean)) +
geom_point(data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
alpha = .5) +
geom_point(data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
alpha = .5) +
geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
geom_half_boxplot(
data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.25),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
fill = "dodgerblue", alpha = .5) +
geom_half_boxplot(
data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .15),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
fill = "darkorange", alpha = .5) +
geom_half_violin(
data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = 1.3),
side = "r", fill = "dodgerblue", alpha = .5, trim = FALSE) +
geom_half_violin(
data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .3),
side = "r", fill = "darkorange", alpha = .5, trim = FALSE) +
scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
xlab("Interval") + ylab("PHQ-9 Mean Score") +
#ggtitle("Paper-Pencil Data (5+5 Timepoints): Individual Pre-Post Means") +
#theme_classic() +
theme_bw() +
coord_cartesian(ylim = c(0, 24))
ggsave("Time Series Dataframes/k20_PP_5.5_Pre-Post_Box_Violin.jpg", plot = Pre_Post_Box_Violin, width = 6, height = 4)
save(Pre_Post_Box_Violin, file = "Time Series Dataframes/k20_PP_5.5_Pre_Post_Box_Violin.RData")
# Repeated measures with box− and violin plots and means + CIs
score_mean_1 = PP_5.5_ts %>% filter(Interval == "1") %>% summarise(mean(Mean)) %>% as.numeric()
score_mean_2 = PP_5.5_ts %>% filter(Interval == "2") %>% summarise(mean(Mean)) %>% as.numeric()
score_median1 = PP_5.5_ts %>% filter(Interval == "1") %>% summarise(median(Mean)) %>% as.numeric()
score_median2 = PP_5.5_ts %>% filter(Interval == "2") %>% summarise(median(Mean)) %>% as.numeric()
score_sd_1 = PP_5.5_ts %>% filter(Interval == "1") %>% summarise(sd(Mean)) %>% as.numeric()
score_sd_2 = PP_5.5_ts %>% filter(Interval == "2") %>% summarise(sd(Mean)) %>% as.numeric()
score_se_1 = score_sd_1/sqrt(nrow(PP_5.5))
score_se_2 = score_sd_2/sqrt(nrow(PP_5.5))
score_ci_1 = PP_5.5_ts %>% filter(Interval == "1") %>% pull(Mean) %>% CI(., ci = 0.95)
score_ci_2 = PP_5.5_ts %>% filter(Interval == "2") %>% pull(Mean) %>% CI(., ci = 0.95)
#Create data frame with 2 rows and 7 columns containing the descriptives
group = c("PRE", "POST")
N = c(nrow(PP_5.5), nrow(PP_5.5))
score_mean = c(score_mean_1, score_mean_2)
score_median = c(score_median1, score_median2)
sd = c(score_sd_1, score_sd_2)
se = c(score_se_1, score_se_2)
ci = c(as.numeric(score_ci_1[1] - score_ci_1[3]), as.numeric(score_ci_2[1] - score_ci_2[3]))
summary_df = data.frame(group, N, score_mean, score_median, sd, se, ci)
# PP_5.5_ts$jit = jitter(PP_5.5_ts$Interval, amount = .09) #already created above
x_tick_means = c(.87, 2.13)
Pre_Post_Box_Violin_Mean_CI = ggplot(data = PP_5.5_ts, aes(y = Mean)) +
geom_point(data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
alpha = .6) +
geom_point(data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
alpha = .6) +
geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
geom_half_boxplot(
data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.28),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
fill = "dodgerblue") +
geom_half_boxplot(
data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .18),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
fill = "darkorange") +
geom_half_violin(
data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.3),
side = "l", fill = "dodgerblue") +
geom_half_violin(
data = PP_5.5_ts %>% filter(Interval == "2"),aes(x = Interval, y = Mean), position = position_nudge(x = .3),
side = "r", fill = "darkorange") +
geom_point(data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1]),
position = position_nudge(x = -.13), color = "dodgerblue", alpha = .6, size = 1.5) +
geom_errorbar(data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1],
ymin = score_mean[1]-ci[1], ymax = score_mean[1]+ci[1]),
position = position_nudge(-.13), color = "dodgerblue", width = 0.05, size = 0.4, alpha = .6) +
geom_point(data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2]),
position = position_nudge(x = .13), color = "darkorange", alpha = .6, size = 1.5)+
geom_errorbar(data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2],
ymin = score_mean[2]-ci[2], ymax = score_mean[2]+ci[2]),
position = position_nudge(.13), color = "darkorange", width = 0.05, size = 0.4, alpha = .6) +
geom_line(data = summary_df, aes(x = x_tick_means, y = score_mean), color = "gray", size = 1) +
scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
xlab("Interval") + ylab("PHQ-9 Mean Score") +
#ggtitle("Paper-Pencil Data (5+5 Timepoints): Individual Pre-Post Means") +
#theme_classic() +
theme_bw() +
coord_cartesian(ylim = c(0, 24))
ggsave("Time Series Dataframes/k20_PP_5.5_Pre-Post_Box_Violin_Mean+CI.jpg", plot = Pre_Post_Box_Violin_Mean_CI, width = 6, height = 4)
save(Pre_Post_Box_Violin_Mean_CI, file = "Time Series Dataframes/k20_PP_5.5_Pre_Post_Box_Violin_Mean_CI.RData")#knitr::include_graphics("Time Series Dataframes/k20_PP_5.5_Pre-Post_Box_Violin.jpg")
knitr::include_graphics("Time Series Dataframes/k20_PP_5.5_Pre-Post_Box_Violin_Mean+CI.jpg")PP_30.30 %>%
select(-(ID1_PRE:ID6_POST)) %>%
within(., {ind.pretestSD = round(ind.pretestSD, digits = 2)
ind.posttestSD = round(ind.posttestSD, digits = 2)}) %>%
head() %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>%
scroll_box(width = "100%")| ID | PRE1_1 | PRE1_2 | PRE1_3 | PRE1_4 | PRE1_5 | PRE1_6 | PRE1_7 | PRE1_8 | PRE1_9 | PRE1_10 | PRE1_11 | PRE1_12 | PRE1_13 | PRE1_14 | PRE1_15 | PRE1_16 | PRE1_17 | PRE1_18 | PRE1_19 | PRE1_20 | PRE1_21 | PRE1_22 | PRE1_23 | PRE1_24 | PRE1_25 | PRE1_26 | PRE1_27 | PRE1_28 | PRE1_29 | PRE1_30 | POST1_1 | POST1_2 | POST1_3 | POST1_4 | POST1_5 | POST1_6 | POST1_7 | POST1_8 | POST1_9 | POST1_10 | POST1_11 | POST1_12 | POST1_13 | POST1_14 | POST1_15 | POST1_16 | POST1_17 | POST1_18 | POST1_19 | POST1_20 | POST1_21 | POST1_22 | POST1_23 | POST1_24 | POST1_25 | POST1_26 | POST1_27 | POST1_28 | POST1_29 | POST1_30 | PRE_Mean | POST_Mean | MeanDiff | ind.pretestSD | ind.posttestSD |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | 8 | 7 | 11 | 8 | 7 | 7 | 10 | 10 | 7 | 7 | 9 | 9 | 6 | 7 | 10 | 9 | 7 | 9 | 10 | 6 | 7 | 7 | 10 | 10 | 7 | 11 | 8 | 8 | 7 | 7 | 1 | 2 | 1 | 4 | 7 | 7 | 4 | 1 | 1 | 2 | 7 | 1 | 1 | 2 | 4 | 2 | 1 | 1 | 4 | 7 | 1 | 1 | 2 | 4 | 7 | 1 | 4 | 2 | 1 | 7 | 8.2 | 3.0 | 5.2 | 1.49 | 2.32 |
| 2 | 9 | 10 | 11 | 11 | 11 | 11 | 11 | 9 | 10 | 11 | 10 | 12 | 10 | 10 | 10 | 10 | 11 | 11 | 11 | 9 | 10 | 11 | 11 | 11 | 9 | 11 | 10 | 11 | 11 | 9 | 13 | 13 | 8 | 12 | 6 | 6 | 14 | 13 | 10 | 9 | 11 | 10 | 10 | 6 | 15 | 14 | 13 | 9 | 10 | 6 | 6 | 9 | 13 | 14 | 10 | 6 | 10 | 9 | 14 | 13 | 10.4 | 10.4 | 0.0 | 0.81 | 2.92 |
| 3 | 8 | 8 | 10 | 11 | 8 | 10 | 10 | 8 | 7 | 10 | 7 | 9 | 9 | 9 | 11 | 11 | 7 | 9 | 9 | 9 | 11 | 7 | 9 | 9 | 9 | 10 | 7 | 10 | 10 | 8 | 1 | 2 | 3 | 2 | 2 | 2 | 1 | 2 | 3 | 2 | 2 | 2 | 2 | 3 | 1 | 1 | 2 | 3 | 2 | 2 | 3 | 2 | 1 | 2 | 2 | 2 | 2 | 2 | 3 | 1 | 9.0 | 2.0 | 7.0 | 1.29 | 0.64 |
| 4 | 10 | 7 | 8 | 5 | 6 | 6 | 8 | 10 | 7 | 5 | 9 | 7 | 8 | 4 | 8 | 9 | 7 | 8 | 8 | 4 | 7 | 9 | 8 | 8 | 4 | 10 | 5 | 6 | 8 | 7 | 6 | 5 | 4 | 3 | 1 | 7 | 4 | 3 | 3 | 2 | 4 | 3 | 1 | 5 | 6 | 5 | 6 | 3 | 4 | 1 | 4 | 3 | 1 | 6 | 5 | 6 | 4 | 5 | 3 | 1 | 7.2 | 3.8 | 3.4 | 1.75 | 1.75 |
| 5 | 9 | 6 | 4 | 7 | 9 | 7 | 9 | 4 | 6 | 9 | 10 | 7 | 5 | 8 | 5 | 5 | 5 | 8 | 7 | 10 | 6 | 9 | 4 | 7 | 9 | 5 | 5 | 8 | 10 | 7 | 6 | 6 | 7 | 4 | 9 | 6 | 4 | 7 | 9 | 6 | 8 | 5 | 4 | 7 | 8 | 7 | 8 | 8 | 5 | 4 | 4 | 5 | 7 | 8 | 8 | 7 | 8 | 8 | 4 | 5 | 7.0 | 6.4 | 0.6 | 1.93 | 1.65 |
| 6 | 12 | 13 | 11 | 10 | 19 | 16 | 7 | 14 | 13 | 15 | 10 | 11 | 13 | 12 | 19 | 18 | 15 | 12 | 11 | 9 | 19 | 13 | 12 | 10 | 11 | 11 | 12 | 10 | 13 | 19 | 11 | 10 | 7 | 7 | 6 | 11 | 10 | 7 | 7 | 6 | 7 | 7 | 12 | 8 | 7 | 11 | 8 | 5 | 9 | 8 | 11 | 6 | 10 | 7 | 7 | 10 | 9 | 5 | 10 | 7 | 13.0 | 8.2 | 4.8 | 3.22 | 1.97 |
Pre-Post-Verläufe für 9 zufällig gezogene Personen
rand = sample(PP_30.30$ID, 9)
x = tibble(ID = c(rep(rand[1],times=61),
rep(rand[2],times=61),
rep(rand[3],times=61),
rep(rand[4],times=61),
rep(rand[5],times=61),
rep(rand[6],times=61),
rep(rand[7],times=61),
rep(rand[8],times=61),
rep(rand[9],times=61)),
MZP = rep(seq(as.Date("2020-01-01"), length.out=61, by="1 day"), times=9),
Score = c(as.numeric(PP_30.30[rand[1],pre_30mzp]), NA, as.numeric(PP_30.30[rand[1],post_30mzp]),
as.numeric(PP_30.30[rand[2],pre_30mzp]), NA, as.numeric(PP_30.30[rand[2],post_30mzp]),
as.numeric(PP_30.30[rand[3],pre_30mzp]), NA, as.numeric(PP_30.30[rand[3],post_30mzp]),
as.numeric(PP_30.30[rand[4],pre_30mzp]), NA, as.numeric(PP_30.30[rand[4],post_30mzp]),
as.numeric(PP_30.30[rand[5],pre_30mzp]), NA, as.numeric(PP_30.30[rand[5],post_30mzp]),
as.numeric(PP_30.30[rand[6],pre_30mzp]), NA, as.numeric(PP_30.30[rand[6],post_30mzp]),
as.numeric(PP_30.30[rand[7],pre_30mzp]), NA, as.numeric(PP_30.30[rand[7],post_30mzp]),
as.numeric(PP_30.30[rand[8],pre_30mzp]), NA, as.numeric(PP_30.30[rand[8],post_30mzp]),
as.numeric(PP_30.30[rand[9],pre_30mzp]), NA, as.numeric(PP_30.30[rand[9],post_30mzp])))
x %>%
group_by(ID) %>%
plot_time_series(MZP, Score,
#.color_var = ID, # for multiple lines in one plot
#.color_lab = "ID",
.facet_ncol = 3,
.facet_scales = "fixed",
.interactive = TRUE,
.facet_collapse = FALSE,
.smooth = TRUE,
.smooth_degree = 2,
.smooth_alpha = 0.5,
.smooth_size = 0.2
)# don´t run this section (code for extremely computation-intense plots that I already stored as .RData and .jpg)
# repeated-measures scatter-boxplot-violin-histograms for individual PRE and POST means
# from van Langen (2020) Open-visualizations tutorial for repeated measures in R
# PP_30.30
# converting my dataframes to use in the same ggplot structure:
PP_30.30_ts = PP_30.30 %>%
select(ID, PRE_Mean, POST_Mean) %>%
pivot_longer(!ID, names_to = "Interval", values_to = "Mean") %>%
mutate(ID = as.factor(ID),
Interval = rep(c(1,2), times = nrow(PP_30.30)))
save(PP_30.30_ts, file = "Time Series Dataframes/k20_PP_30.30_ts.RData")
###
load("Time Series Dataframes/k20_PP_30.30_ts.RData")
# Repeated measures with box− and violin plots
PP_30.30_ts$jit = jitter(PP_30.30_ts$Interval, amount = .09)
Pre_Post_Box_Violin = ggplot(data = PP_30.30_ts, aes(y = Mean)) +
geom_point(data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
alpha = .5) +
geom_point(data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
alpha = .5) +
geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
geom_half_boxplot(
data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.25),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
fill = "dodgerblue", alpha = .5) +
geom_half_boxplot(
data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .15),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
fill = "darkorange", alpha = .5) +
geom_half_violin(
data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = 1.3),
side = "r", fill = "dodgerblue", alpha = .5, trim = FALSE) +
geom_half_violin(
data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .3),
side = "r", fill = "darkorange", alpha = .5, trim = FALSE) +
scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
xlab("Interval") + ylab("PHQ-9 Mean Score") +
#ggtitle("Paper-Pencil Data (30+30 Timepoints): Individual Pre-Post Means") +
#theme_classic() +
theme_bw() +
coord_cartesian(ylim = c(0, 24))
ggsave("Time Series Dataframes/k20_PP_30.30_Pre-Post_Box_Violin.jpg", plot = Pre_Post_Box_Violin, width = 6, height = 4)
save(Pre_Post_Box_Violin, file = "Time Series Dataframes/k20_PP_30.30_Pre_Post_Box_Violin.RData")
# Repeated measures with box− and violin plots and means + CIs
score_mean_1 = PP_30.30_ts %>% filter(Interval == "1") %>% summarise(mean(Mean)) %>% as.numeric()
score_mean_2 = PP_30.30_ts %>% filter(Interval == "2") %>% summarise(mean(Mean)) %>% as.numeric()
score_median1 = PP_30.30_ts %>% filter(Interval == "1") %>% summarise(median(Mean)) %>% as.numeric()
score_median2 = PP_30.30_ts %>% filter(Interval == "2") %>% summarise(median(Mean)) %>% as.numeric()
score_sd_1 = PP_30.30_ts %>% filter(Interval == "1") %>% summarise(sd(Mean)) %>% as.numeric()
score_sd_2 = PP_30.30_ts %>% filter(Interval == "2") %>% summarise(sd(Mean)) %>% as.numeric()
score_se_1 = score_sd_1/sqrt(nrow(PP_30.30))
score_se_2 = score_sd_2/sqrt(nrow(PP_30.30))
score_ci_1 = PP_30.30_ts %>% filter(Interval == "1") %>% pull(Mean) %>% CI(., ci = 0.95)
score_ci_2 = PP_30.30_ts %>% filter(Interval == "2") %>% pull(Mean) %>% CI(., ci = 0.95)
#Create data frame with 2 rows and 7 columns containing the descriptives
group = c("PRE", "POST")
N = c(nrow(PP_30.30), nrow(PP_30.30))
score_mean = c(score_mean_1, score_mean_2)
score_median = c(score_median1, score_median2)
sd = c(score_sd_1, score_sd_2)
se = c(score_se_1, score_se_2)
ci = c((score_ci_1[1] - score_ci_1[3]), (score_ci_2[1] - score_ci_2[3]))
summary_df = data.frame(group, N, score_mean, score_median, sd, se, ci)
# PP_30.30_ts$jit = jitter(PP_30.30_ts$Interval, amount = .09) #already created above
x_tick_means = c(.87, 2.13)
Pre_Post_Box_Violin_Mean_CI = ggplot(data = PP_30.30_ts, aes(y = Mean)) +
geom_point(data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
alpha = .6) +
geom_point(data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
alpha = .6) +
geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
geom_half_boxplot(
data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.28),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
fill = "dodgerblue") +
geom_half_boxplot(
data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .18),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
fill = "darkorange") +
geom_half_violin(
data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.3),
side = "l", fill = "dodgerblue") +
geom_half_violin(
data = PP_30.30_ts %>% filter(Interval == "2"),aes(x = Interval, y = Mean), position = position_nudge(x = .3),
side = "r", fill = "darkorange") +
geom_point(data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1]),
position = position_nudge(x = -.13), color = "dodgerblue", alpha = .6, size = 1.5) +
geom_errorbar(data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1],
ymin = score_mean[1]-ci[1], ymax = score_mean[1]+ci[1]),
position = position_nudge(-.13), color = "dodgerblue", width = 0.05, size = 0.4, alpha = .6) +
geom_point(data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2]),
position = position_nudge(x = .13), color = "darkorange", alpha = .6, size = 1.5)+
geom_errorbar(data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2],
ymin = score_mean[2]-ci[2], ymax = score_mean[2]+ci[2]),
position = position_nudge(.13), color = "darkorange", width = 0.05, size = 0.4, alpha = .6) +
geom_line(data = summary_df, aes(x = x_tick_means, y = score_mean), color = "gray", size = 1) +
scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
xlab("Interval") + ylab("PHQ-9 Mean Score") +
#ggtitle("Paper-Pencil Data (30+30 Timepoints): Individual Pre-Post Means") +
#theme_classic() +
theme_bw() +
coord_cartesian(ylim = c(0, 24))
ggsave("Time Series Dataframes/k20_PP_30.30_Pre-Post_Box_Violin_Mean+CI.jpg", plot = Pre_Post_Box_Violin_Mean_CI, width = 6, height = 4)
save(Pre_Post_Box_Violin_Mean_CI, file = "Time Series Dataframes/k20_PP_30.30_Pre_Post_Box_Violin_Mean_CI.RData")#knitr::include_graphics("Time Series Dataframes/k20_PP_30.30_Pre-Post_Box_Violin.jpg")
knitr::include_graphics("Time Series Dataframes/k20_PP_30.30_Pre-Post_Box_Violin_Mean+CI.jpg")kable(head(PP_1.1)) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| ID | ID_orig | PRE | POST | Diff |
|---|---|---|---|---|
| 1 | 1 | 8 | 1 | 7 |
| 2 | 2 | 9 | 13 | -4 |
| 3 | 3 | 8 | 1 | 7 |
| 4 | 4 | 10 | 6 | 4 |
| 5 | 5 | 9 | 6 | 3 |
| 6 | 6 | 12 | 11 | 1 |
Pre-Post-Verläufe für 9 zufällig gezogene Personen
rand = sample(PP_1.1$ID, 9)
x = tibble(ID = c(rep(rand[1],times=3),
rep(rand[2],times=3),
rep(rand[3],times=3),
rep(rand[4],times=3),
rep(rand[5],times=3),
rep(rand[6],times=3),
rep(rand[7],times=3),
rep(rand[8],times=3),
rep(rand[9],times=3)),
MZP = rep(seq(as.Date("2020-01-01"), length.out=3, by="1 day"), times=9),
Score = c(as.numeric(PP_1.1[rand[1],"PRE"]), NA, as.numeric(PP_1.1[rand[1],"POST"]),
as.numeric(PP_1.1[rand[2],"PRE"]), NA, as.numeric(PP_1.1[rand[2],"POST"]),
as.numeric(PP_1.1[rand[3],"PRE"]), NA, as.numeric(PP_1.1[rand[3],"POST"]),
as.numeric(PP_1.1[rand[4],"PRE"]), NA, as.numeric(PP_1.1[rand[4],"POST"]),
as.numeric(PP_1.1[rand[5],"PRE"]), NA, as.numeric(PP_1.1[rand[5],"POST"]),
as.numeric(PP_1.1[rand[6],"PRE"]), NA, as.numeric(PP_1.1[rand[6],"POST"]),
as.numeric(PP_1.1[rand[7],"PRE"]), NA, as.numeric(PP_1.1[rand[7],"POST"]),
as.numeric(PP_1.1[rand[8],"PRE"]), NA, as.numeric(PP_1.1[rand[8],"POST"]),
as.numeric(PP_1.1[rand[9],"PRE"]), NA, as.numeric(PP_1.1[rand[9],"POST"])))
x %>%
group_by(ID) %>%
plot_time_series(MZP, Score,
#.color_var = ID, # for multiple lines in one plot
#.color_lab = "ID",
.facet_ncol = 3,
.facet_scales = "fixed",
.interactive = TRUE,
.facet_collapse = FALSE,
.smooth = TRUE,
.smooth_degree = 2,
.smooth_alpha = 0.5,
.smooth_size = 0.2
)# don´t run this section (code for extremely computation-intense plots that I already stored as .RData and .jpg)
# repeated-measures scatter-boxplot-violin-histograms for individual PRE and POST means
# from van Langen (2020) Open-visualizations tutorial for repeated measures in R
# PP_1.1
# converting my dataframes to use in the same ggplot structure:
PP_1.1_ts = PP_1.1 %>%
select(ID, PRE, POST) %>%
pivot_longer(!ID, names_to = "Timepoint", values_to = "Score") %>%
mutate(ID = as.factor(ID),
Timepoint = rep(c(1,2), times = nrow(PP_1.1)))
save(PP_1.1_ts, file = "Time Series Dataframes/k20_PP_1.1_ts.RData")
###
load("Time Series Dataframes/k20_PP_1.1_ts.RData")
# Repeated measures with box− and violin plots
PP_1.1_ts$jit = jitter(PP_1.1_ts$Timepoint, amount = .09)
Pre_Post_Box_Violin = ggplot(data = PP_1.1_ts, aes(y = Score)) +
geom_point(data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = jit), color = "dodgerblue", size = 1,
alpha = .5) +
geom_point(data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = jit), color = "darkorange", size = 1,
alpha = .5) +
geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
geom_half_boxplot(
data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = Timepoint, y = Score), position = position_nudge(x = -.25),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
fill = "dodgerblue", alpha = .5) +
geom_half_boxplot(
data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = Timepoint, y = Score), position = position_nudge(x = .15),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
fill = "darkorange", alpha = .5) +
geom_half_violin(
data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = Timepoint, y = Score), position = position_nudge(x = 1.3),
side = "r", fill = "dodgerblue", alpha = .5, trim = FALSE) +
geom_half_violin(
data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = Timepoint, y = Score), position = position_nudge(x = .3),
side = "r", fill = "darkorange", alpha = .5, trim = FALSE) +
scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
xlab("Single Assessment") + ylab("PHQ-9 Score") +
#ggtitle("Paper-Pencil Data (1+1 Timepoints): Individual Pre-Post Means") +
#theme_classic() +
theme_bw() +
coord_cartesian(ylim = c(0, 24))
ggsave("Time Series Dataframes/k20_PP_1.1_Pre-Post_Box_Violin.jpg", plot = Pre_Post_Box_Violin, width = 6, height = 4)
save(Pre_Post_Box_Violin, file = "Time Series Dataframes/k20_PP_1.1_Pre_Post_Box_Violin.RData")
# Repeated measures with box− and violin plots and means + CIs
score_mean_1 = PP_1.1_ts %>% filter(Timepoint == "1") %>% summarise(mean(Score)) %>% as.numeric()
score_mean_2 = PP_1.1_ts %>% filter(Timepoint == "2") %>% summarise(mean(Score)) %>% as.numeric()
score_median1 = PP_1.1_ts %>% filter(Timepoint == "1") %>% summarise(median(Score)) %>% as.numeric()
score_median2 = PP_1.1_ts %>% filter(Timepoint == "2") %>% summarise(median(Score)) %>% as.numeric()
score_sd_1 = PP_1.1_ts %>% filter(Timepoint == "1") %>% summarise(sd(Score)) %>% as.numeric()
score_sd_2 = PP_1.1_ts %>% filter(Timepoint == "2") %>% summarise(sd(Score)) %>% as.numeric()
score_se_1 = score_sd_1/sqrt(nrow(PP_1.1))
score_se_2 = score_sd_2/sqrt(nrow(PP_1.1))
score_ci_1 = PP_1.1_ts %>% filter(Timepoint == "1") %>% pull(Score) %>% CI(., ci = 0.95)
score_ci_2 = PP_1.1_ts %>% filter(Timepoint == "2") %>% pull(Score) %>% CI(., ci = 0.95)
#Create data frame with 2 rows and 7 columns containing the descriptives
group = c("PRE", "POST")
N = c(nrow(PP_1.1), nrow(PP_1.1))
score_mean = c(score_mean_1, score_mean_2)
score_median = c(score_median1, score_median2)
sd = c(score_sd_1, score_sd_2)
se = c(score_se_1, score_se_2)
ci = c((score_ci_1[1] - score_ci_1[3]), (score_ci_2[1] - score_ci_2[3]))
summary_df = data.frame(group, N, score_mean, score_median, sd, se, ci)
# PP_1.1_ts$jit = jitter(PP_1.1_ts$Timepoint, amount = .09) #already created above
x_tick_means = c(.87, 2.13)
Pre_Post_Box_Violin_Mean_CI = ggplot(data = PP_1.1_ts, aes(y = Score)) +
geom_point(data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = jit), color = "dodgerblue", size = 1,
alpha = .6) +
geom_point(data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = jit), color = "darkorange", size = 1,
alpha = .6) +
geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
geom_half_boxplot(
data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = Timepoint, y = Score), position = position_nudge(x = -.28),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
fill = "dodgerblue") +
geom_half_boxplot(
data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = Timepoint, y = Score), position = position_nudge(x = .18),
side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
fill = "darkorange") +
geom_half_violin(
data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = Timepoint, y = Score), position = position_nudge(x = -.3),
side = "l", fill = "dodgerblue") +
geom_half_violin(
data = PP_1.1_ts %>% filter(Timepoint == "2"),aes(x = Timepoint, y = Score), position = position_nudge(x = .3),
side = "r", fill = "darkorange") +
geom_point(data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = Timepoint, y = score_mean[1]),
position = position_nudge(x = -.13), color = "dodgerblue", alpha = .6, size = 1.5) +
geom_errorbar(data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = Timepoint, y = score_mean[1],
ymin = score_mean[1]-ci[1], ymax = score_mean[1]+ci[1]),
position = position_nudge(-.13), color = "dodgerblue", width = 0.05, size = 0.4, alpha = .6) +
geom_point(data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = Timepoint, y = score_mean[2]),
position = position_nudge(x = .13), color = "darkorange", alpha = .6, size = 1.5)+
geom_errorbar(data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = Timepoint, y = score_mean[2],
ymin = score_mean[2]-ci[2], ymax = score_mean[2]+ci[2]),
position = position_nudge(.13), color = "darkorange", width = 0.05, size = 0.4, alpha = .6) +
geom_line(data = summary_df, aes(x = x_tick_means, y = score_mean), color = "gray", size = 1) +
scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
xlab("Single Assessment") + ylab("PHQ-9 Score") +
#ggtitle("Paper-Pencil Data (1+1 Timepoints): Individual Pre-Post Means") +
#theme_classic() +
theme_bw() +
coord_cartesian(ylim = c(0, 24))
ggsave("Time Series Dataframes/k20_PP_1.1_Pre-Post_Box_Violin_Mean+CI.jpg", plot = Pre_Post_Box_Violin_Mean_CI, width = 6, height = 4)
save(Pre_Post_Box_Violin_Mean_CI, file = "Time Series Dataframes/k20_PP_1.1_Pre_Post_Box_Violin_Mean_CI.RData")#knitr::include_graphics("Time Series Dataframes/k20_PP_1.1_Pre-Post_Box_Violin.jpg")
knitr::include_graphics("Time Series Dataframes/k20_PP_1.1_Pre-Post_Box_Violin_Mean+CI.jpg")tibble(Descriptives = c("mean_PRE_Mean","mean_POST_Mean","mean_MeanDiff","mean_PRE_1MZP","mean_POST_1MZP",
"mean_Diff_1MZP","mean_ind.pretestSD","mean_ind.posttestSD","sd_PRE_1MZP","sd_POST_1MZP"),
PP_5.5 = round(c(mean(PP_5.5$PRE_Mean),mean(PP_5.5$POST_Mean),mean(PP_5.5$MeanDiff),NA,NA,NA,
mean(PP_5.5$ind.pretestSD),mean(PP_5.5$ind.posttestSD),NA,NA), digits = 3),
PP_30.30 = round(c(mean(PP_30.30$PRE_Mean),mean(PP_30.30$POST_Mean),mean(PP_30.30$MeanDiff),
NA,NA,NA,mean(PP_30.30$ind.pretestSD),mean(PP_30.30$ind.posttestSD),NA,NA), digits = 3),
PP_1.1 = round(c(NA,NA,NA,mean(PP_1.1$PRE),mean(PP_1.1$POST),mean(PP_1.1$Diff),
NA,NA,sd(PP_1.1$PRE),sd(PP_1.1$POST)), digits = 3)) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| Descriptives | PP_5.5 | PP_30.30 | PP_1.1 |
|---|---|---|---|
| mean_PRE_Mean | 10.335 | 10.335 | NA |
| mean_POST_Mean | 7.077 | 7.077 | NA |
| mean_MeanDiff | 3.258 | 3.258 | NA |
| mean_PRE_1MZP | NA | NA | 10.321 |
| mean_POST_1MZP | NA | NA | 7.036 |
| mean_Diff_1MZP | NA | NA | 3.286 |
| mean_ind.pretestSD | 2.047 | 1.862 | NA |
| mean_ind.posttestSD | 2.531 | 2.302 | NA |
| sd_PRE_1MZP | NA | NA | 3.196 |
| sd_POST_1MZP | NA | NA | 3.941 |
Boxplots der Pre- und Post-(Mittel-)Werte
# Boxplots zum Vergleich
temp = tibble(Scores = c(PP_5.5$PRE_Mean, PP_30.30$PRE_Mean, PP_1.1$PRE),
Datasets = rep(c("PP_5.5", "PP_30.30", "PP_1.1"), each = length(PP_5.5$PRE_Mean)))
ggplot(temp, aes(x = Datasets, y = Scores)) +
geom_boxplot() +
ylim(0, 27) +
ggtitle("PHQ-9 PRE(-Mean)") +
xlab("Dataset") +
ylab("PHQ-9 Scores")temp = tibble(Scores = c(PP_5.5$POST_Mean, PP_30.30$POST_Mean, PP_1.1$POST),
Datasets = rep(c("PP_5.5", "PP_30.30", "PP_1.1"), each = length(PP_5.5$POST_Mean)))
ggplot(temp, aes(x = Datasets, y = Scores)) +
geom_boxplot() +
ylim(0, 27) +
ggtitle("PHQ-9 POST(-Mean)") +
xlab("Dataset") +
ylab("PHQ-9 Scores")Prozentuale Überlappung der Pre-(Mittel-)Werte
# Overlap-Plots zum Vergleich
final.plot(list(PP_5.5_PRE_Mean = PP_5.5$PRE_Mean, PP_30.30_PRE_Mean = PP_30.30$PRE_Mean),
overlap(list(PP_5.5_PRE_Mean = PP_5.5$PRE_Mean, PP_30.30_PRE_Mean = PP_30.30$PRE_Mean))$OV)
final.plot(list(PP_5.5_PRE_Mean = PP_5.5$PRE_Mean, PP_1.1_PRE = PP_1.1$PRE),
overlap(list(PP_5.5_PRE_Mean = PP_5.5$PRE_Mean, PP_1.1_PRE = PP_1.1$PRE))$OV)
final.plot(list(PP_30.30_PRE_Mean = PP_30.30$PRE_Mean, PP_1.1_PRE = PP_1.1$PRE),
overlap(list(PP_30.30_PRE_Mean = PP_30.30$PRE_Mean, PP_1.1_PRE = PP_1.1$PRE))$OV)Prozentuale Überlappung der Post-(Mittel-)Werte
# Overlap-Plots zum Vergleich
final.plot(list(PP_5.5_POST_Mean = PP_5.5$POST_Mean, PP_30MZP_POST_Mean = PP_30.30$POST_Mean),
overlap(list(PP_5.5_POST_Mean = PP_5.5$POST_Mean, PP_30MZP_POST_Mean = PP_30.30$POST_Mean))$OV)
final.plot(list(PP_5.5_POST_Mean = PP_5.5$POST_Mean, PP_1.1_POST = PP_1.1$POST),
overlap(list(PP_5.5_POST_Mean = PP_5.5$POST_Mean, PP_1.1_POST = PP_1.1$POST))$OV)
final.plot(list(PP_30MZP_POST_Mean = PP_30.30$POST_Mean, PP_1.1_POST = PP_1.1$POST),
overlap(list(PP_30MZP_POST_Mean = PP_30.30$POST_Mean, PP_1.1_POST = PP_1.1$POST))$OV)# Korrelationsmatrix von PRE- und POST-MZP:
PP_5.5_KorMat = cor(PP_5.5[, c(pre_5mzp, post_5mzp)]) %>%
round(., digits = 2)
# durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden MZP (Fisher-Z-transformiert):
pre_inter_item_rtt = 0L
for (i in 1:4) {
pre_inter_item_rtt = pre_inter_item_rtt + FisherZ(PP_5.5_KorMat[i,i+1])
}
pre_inter_item_rtt = FisherZInv(pre_inter_item_rtt / 4)
post_inter_item_rtt = 0L
for (i in 5:9) {
post_inter_item_rtt = post_inter_item_rtt + FisherZ(PP_5.5_KorMat[i,i+1])
}
post_inter_item_rtt = FisherZInv(post_inter_item_rtt / 4)
for (i in 1:9) {
PP_5.5_KorMat[i, i+1] = cell_spec(PP_5.5_KorMat[i, i+1], "html", bold = TRUE)
}
rownames(PP_5.5_KorMat) = cell_spec(rownames(PP_5.5_KorMat), "html", bold = TRUE)
PP_5.5_KorMat %>%
kable(., format = "html", escape = FALSE) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, fixed_thead = T)| PRE1_1 | PRE1_2 | PRE1_3 | PRE1_4 | PRE1_5 | POST1_1 | POST1_2 | POST1_3 | POST1_4 | POST1_5 | |
|---|---|---|---|---|---|---|---|---|---|---|
| PRE1_1 | 1 | 0.67 | 0.49 | 0.37 | 0.29 | 0.34 | 0.22 | 0.16 | 0.12 | 0.09 |
| PRE1_2 | 0.67 | 1 | 0.68 | 0.5 | 0.38 | 0.23 | 0.15 | 0.11 | 0.09 | 0.07 |
| PRE1_3 | 0.49 | 0.68 | 1 | 0.68 | 0.49 | 0.17 | 0.11 | 0.09 | 0.07 | 0.05 |
| PRE1_4 | 0.37 | 0.5 | 0.68 | 1 | 0.67 | 0.13 | 0.08 | 0.06 | 0.06 | 0.04 |
| PRE1_5 | 0.29 | 0.38 | 0.49 | 0.67 | 1 | 0.1 | 0.06 | 0.07 | 0.05 | 0.03 |
| POST1_1 | 0.34 | 0.23 | 0.17 | 0.13 | 0.1 | 1 | 0.66 | 0.48 | 0.36 | 0.28 |
| POST1_2 | 0.22 | 0.15 | 0.11 | 0.08 | 0.06 | 0.66 | 1 | 0.67 | 0.49 | 0.37 |
| POST1_3 | 0.16 | 0.11 | 0.09 | 0.06 | 0.07 | 0.48 | 0.67 | 1 | 0.68 | 0.48 |
| POST1_4 | 0.12 | 0.09 | 0.07 | 0.06 | 0.05 | 0.36 | 0.49 | 0.68 | 1 | 0.66 |
| POST1_5 | 0.09 | 0.07 | 0.05 | 0.04 | 0.03 | 0.28 | 0.37 | 0.48 | 0.66 | 1 |
# mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP:
PRE_alpha = CronbachAlpha(PP_5.5[pre_5mzp])
POST_alpha = CronbachAlpha(PP_5.5[post_5mzp])
PP_5.5_Alpha = FisherZInv(mean(c(FisherZ(PRE_alpha), FisherZ(POST_alpha))))Korrelation zwischen den Pre- und Post-Intervall-Mittelwerten = 0.179.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Pre-MZP (Fisher-Z-transformiert): r = 0.68.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Post-MZP (Fisher-Z-transformiert): r = 0.68.
Mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP = 0.843.
# Korrelationsmatrix von PRE- und POST-MZP:
PP_30.30_KorMat = cor(PP_30.30[, c(pre_30mzp, post_30mzp)]) %>%
round(., digits = 2)
# durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden MZP (Fisher-Z-transformiert):
pre_inter_item_rtt = 0L
for (i in 1:29) {
pre_inter_item_rtt = pre_inter_item_rtt + FisherZ(PP_30.30_KorMat[i,i+1])
}
pre_inter_item_rtt = FisherZInv(pre_inter_item_rtt / 29)
post_inter_item_rtt = 0L
for (i in 31:59) {
post_inter_item_rtt = post_inter_item_rtt + FisherZ(PP_30.30_KorMat[i,i+1])
}
post_inter_item_rtt = FisherZInv(post_inter_item_rtt / 29)
for (i in 1:59) {
PP_30.30_KorMat[i, i+1] = cell_spec(PP_30.30_KorMat[i, i+1], "html", bold = TRUE)
}
rownames(PP_30.30_KorMat) = cell_spec(rownames(PP_30.30_KorMat), "html", bold = TRUE)
PP_30.30_KorMat %>%
kable(., format = "html", escape = FALSE) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE, fixed_thead = T) %>%
scroll_box(height = "800px")| PRE1_1 | PRE1_2 | PRE1_3 | PRE1_4 | PRE1_5 | PRE1_6 | PRE1_7 | PRE1_8 | PRE1_9 | PRE1_10 | PRE1_11 | PRE1_12 | PRE1_13 | PRE1_14 | PRE1_15 | PRE1_16 | PRE1_17 | PRE1_18 | PRE1_19 | PRE1_20 | PRE1_21 | PRE1_22 | PRE1_23 | PRE1_24 | PRE1_25 | PRE1_26 | PRE1_27 | PRE1_28 | PRE1_29 | PRE1_30 | POST1_1 | POST1_2 | POST1_3 | POST1_4 | POST1_5 | POST1_6 | POST1_7 | POST1_8 | POST1_9 | POST1_10 | POST1_11 | POST1_12 | POST1_13 | POST1_14 | POST1_15 | POST1_16 | POST1_17 | POST1_18 | POST1_19 | POST1_20 | POST1_21 | POST1_22 | POST1_23 | POST1_24 | POST1_25 | POST1_26 | POST1_27 | POST1_28 | POST1_29 | POST1_30 | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| PRE1_1 | 1 | 0.67 | 0.49 | 0.37 | 0.29 | 0.51 | 0.58 | 0.6 | 0.59 | 0.53 | 0.51 | 0.59 | 0.61 | 0.59 | 0.51 | 0.54 | 0.58 | 0.6 | 0.58 | 0.51 | 0.53 | 0.59 | 0.6 | 0.58 | 0.52 | 0.5 | 0.59 | 0.61 | 0.58 | 0.53 | 0.34 | 0.22 | 0.16 | 0.12 | 0.09 | 0.16 | 0.2 | 0.2 | 0.2 | 0.17 | 0.18 | 0.19 | 0.19 | 0.19 | 0.18 | 0.15 | 0.19 | 0.21 | 0.2 | 0.18 | 0.17 | 0.2 | 0.2 | 0.19 | 0.17 | 0.18 | 0.2 | 0.2 | 0.19 | 0.16 |
| PRE1_2 | 0.67 | 1 | 0.68 | 0.5 | 0.38 | 0.59 | 0.67 | 0.7 | 0.67 | 0.59 | 0.58 | 0.68 | 0.7 | 0.68 | 0.59 | 0.61 | 0.68 | 0.7 | 0.66 | 0.57 | 0.59 | 0.68 | 0.7 | 0.66 | 0.59 | 0.59 | 0.67 | 0.7 | 0.67 | 0.6 | 0.23 | 0.15 | 0.11 | 0.09 | 0.07 | 0.12 | 0.14 | 0.14 | 0.13 | 0.11 | 0.12 | 0.13 | 0.13 | 0.13 | 0.13 | 0.11 | 0.14 | 0.14 | 0.14 | 0.12 | 0.12 | 0.14 | 0.14 | 0.13 | 0.12 | 0.13 | 0.14 | 0.13 | 0.13 | 0.12 |
| PRE1_3 | 0.49 | 0.68 | 1 | 0.68 | 0.49 | 0.62 | 0.7 | 0.72 | 0.69 | 0.61 | 0.61 | 0.69 | 0.72 | 0.71 | 0.61 | 0.62 | 0.71 | 0.73 | 0.69 | 0.59 | 0.61 | 0.7 | 0.74 | 0.69 | 0.61 | 0.6 | 0.69 | 0.73 | 0.7 | 0.62 | 0.17 | 0.11 | 0.09 | 0.07 | 0.05 | 0.08 | 0.11 | 0.11 | 0.1 | 0.09 | 0.08 | 0.1 | 0.1 | 0.11 | 0.1 | 0.09 | 0.11 | 0.11 | 0.1 | 0.09 | 0.09 | 0.09 | 0.11 | 0.11 | 0.09 | 0.09 | 0.11 | 0.1 | 0.11 | 0.09 |
| PRE1_4 | 0.37 | 0.5 | 0.68 | 1 | 0.67 | 0.6 | 0.69 | 0.69 | 0.66 | 0.58 | 0.59 | 0.67 | 0.7 | 0.68 | 0.58 | 0.6 | 0.67 | 0.7 | 0.67 | 0.58 | 0.59 | 0.67 | 0.7 | 0.67 | 0.59 | 0.57 | 0.68 | 0.71 | 0.67 | 0.6 | 0.13 | 0.08 | 0.06 | 0.06 | 0.04 | 0.06 | 0.08 | 0.09 | 0.08 | 0.05 | 0.07 | 0.08 | 0.08 | 0.08 | 0.06 | 0.07 | 0.07 | 0.08 | 0.08 | 0.07 | 0.07 | 0.06 | 0.08 | 0.08 | 0.06 | 0.06 | 0.08 | 0.08 | 0.08 | 0.06 |
| PRE1_5 | 0.29 | 0.38 | 0.49 | 0.67 | 1 | 0.54 | 0.6 | 0.61 | 0.58 | 0.52 | 0.51 | 0.6 | 0.62 | 0.59 | 0.51 | 0.53 | 0.58 | 0.61 | 0.6 | 0.52 | 0.54 | 0.59 | 0.61 | 0.59 | 0.51 | 0.52 | 0.59 | 0.62 | 0.58 | 0.54 | 0.1 | 0.06 | 0.07 | 0.05 | 0.03 | 0.06 | 0.08 | 0.07 | 0.05 | 0.05 | 0.05 | 0.07 | 0.07 | 0.07 | 0.05 | 0.07 | 0.06 | 0.06 | 0.06 | 0.06 | 0.06 | 0.05 | 0.07 | 0.07 | 0.06 | 0.04 | 0.07 | 0.07 | 0.07 | 0.06 |
| PRE1_6 | 0.51 | 0.59 | 0.62 | 0.6 | 0.54 | 1 | 0.68 | 0.5 | 0.38 | 0.31 | 0.51 | 0.61 | 0.63 | 0.59 | 0.52 | 0.55 | 0.58 | 0.61 | 0.6 | 0.52 | 0.52 | 0.6 | 0.63 | 0.59 | 0.53 | 0.52 | 0.6 | 0.63 | 0.58 | 0.54 | 0.18 | 0.12 | 0.08 | 0.06 | 0.04 | 0.08 | 0.11 | 0.11 | 0.1 | 0.08 | 0.09 | 0.1 | 0.1 | 0.1 | 0.09 | 0.09 | 0.1 | 0.1 | 0.1 | 0.09 | 0.09 | 0.1 | 0.11 | 0.1 | 0.09 | 0.08 | 0.1 | 0.11 | 0.11 | 0.08 |
| PRE1_7 | 0.58 | 0.67 | 0.7 | 0.69 | 0.6 | 0.68 | 1 | 0.67 | 0.5 | 0.38 | 0.57 | 0.69 | 0.71 | 0.67 | 0.59 | 0.61 | 0.67 | 0.69 | 0.67 | 0.58 | 0.59 | 0.68 | 0.7 | 0.68 | 0.58 | 0.57 | 0.67 | 0.72 | 0.69 | 0.59 | 0.2 | 0.12 | 0.09 | 0.07 | 0.04 | 0.09 | 0.12 | 0.12 | 0.1 | 0.09 | 0.09 | 0.11 | 0.11 | 0.11 | 0.11 | 0.09 | 0.11 | 0.11 | 0.11 | 0.1 | 0.1 | 0.1 | 0.11 | 0.11 | 0.1 | 0.09 | 0.12 | 0.11 | 0.11 | 0.09 |
| PRE1_8 | 0.6 | 0.7 | 0.72 | 0.69 | 0.61 | 0.5 | 0.67 | 1 | 0.67 | 0.5 | 0.6 | 0.68 | 0.74 | 0.71 | 0.6 | 0.63 | 0.69 | 0.71 | 0.69 | 0.61 | 0.62 | 0.7 | 0.72 | 0.68 | 0.61 | 0.61 | 0.69 | 0.74 | 0.69 | 0.6 | 0.2 | 0.12 | 0.09 | 0.07 | 0.05 | 0.09 | 0.12 | 0.12 | 0.11 | 0.09 | 0.1 | 0.11 | 0.11 | 0.11 | 0.11 | 0.09 | 0.11 | 0.12 | 0.11 | 0.1 | 0.1 | 0.1 | 0.12 | 0.11 | 0.1 | 0.1 | 0.12 | 0.11 | 0.11 | 0.1 |
| PRE1_9 | 0.59 | 0.67 | 0.69 | 0.66 | 0.58 | 0.38 | 0.5 | 0.67 | 1 | 0.65 | 0.6 | 0.66 | 0.69 | 0.68 | 0.58 | 0.59 | 0.67 | 0.71 | 0.66 | 0.56 | 0.57 | 0.69 | 0.69 | 0.66 | 0.59 | 0.58 | 0.66 | 0.67 | 0.68 | 0.61 | 0.2 | 0.14 | 0.12 | 0.11 | 0.08 | 0.12 | 0.14 | 0.14 | 0.13 | 0.11 | 0.12 | 0.13 | 0.13 | 0.14 | 0.12 | 0.12 | 0.13 | 0.14 | 0.13 | 0.12 | 0.12 | 0.12 | 0.14 | 0.14 | 0.11 | 0.11 | 0.14 | 0.13 | 0.14 | 0.12 |
| PRE1_10 | 0.53 | 0.59 | 0.61 | 0.58 | 0.52 | 0.31 | 0.38 | 0.5 | 0.65 | 1 | 0.53 | 0.6 | 0.6 | 0.6 | 0.51 | 0.53 | 0.6 | 0.61 | 0.59 | 0.51 | 0.56 | 0.59 | 0.61 | 0.58 | 0.51 | 0.52 | 0.61 | 0.61 | 0.58 | 0.53 | 0.18 | 0.13 | 0.1 | 0.1 | 0.06 | 0.1 | 0.13 | 0.13 | 0.12 | 0.1 | 0.11 | 0.12 | 0.12 | 0.12 | 0.1 | 0.1 | 0.11 | 0.12 | 0.13 | 0.11 | 0.11 | 0.12 | 0.12 | 0.12 | 0.11 | 0.11 | 0.12 | 0.12 | 0.12 | 0.1 |
| PRE1_11 | 0.51 | 0.58 | 0.61 | 0.59 | 0.51 | 0.51 | 0.57 | 0.6 | 0.6 | 0.53 | 1 | 0.65 | 0.48 | 0.39 | 0.29 | 0.52 | 0.59 | 0.6 | 0.58 | 0.52 | 0.51 | 0.58 | 0.6 | 0.58 | 0.54 | 0.51 | 0.56 | 0.59 | 0.58 | 0.55 | 0.18 | 0.11 | 0.09 | 0.07 | 0.04 | 0.09 | 0.1 | 0.1 | 0.1 | 0.09 | 0.09 | 0.1 | 0.1 | 0.1 | 0.09 | 0.09 | 0.1 | 0.11 | 0.1 | 0.08 | 0.09 | 0.1 | 0.1 | 0.1 | 0.09 | 0.08 | 0.11 | 0.1 | 0.1 | 0.09 |
| PRE1_12 | 0.59 | 0.68 | 0.69 | 0.67 | 0.6 | 0.61 | 0.69 | 0.68 | 0.66 | 0.6 | 0.65 | 1 | 0.7 | 0.51 | 0.37 | 0.61 | 0.66 | 0.7 | 0.68 | 0.59 | 0.59 | 0.68 | 0.7 | 0.67 | 0.59 | 0.58 | 0.68 | 0.7 | 0.68 | 0.6 | 0.21 | 0.13 | 0.1 | 0.09 | 0.06 | 0.11 | 0.14 | 0.13 | 0.12 | 0.1 | 0.11 | 0.13 | 0.12 | 0.12 | 0.11 | 0.11 | 0.12 | 0.14 | 0.12 | 0.11 | 0.11 | 0.12 | 0.13 | 0.13 | 0.12 | 0.11 | 0.13 | 0.13 | 0.12 | 0.11 |
| PRE1_13 | 0.61 | 0.7 | 0.72 | 0.7 | 0.62 | 0.63 | 0.71 | 0.74 | 0.69 | 0.6 | 0.48 | 0.7 | 1 | 0.69 | 0.48 | 0.62 | 0.7 | 0.74 | 0.71 | 0.59 | 0.64 | 0.72 | 0.73 | 0.69 | 0.58 | 0.6 | 0.69 | 0.75 | 0.7 | 0.62 | 0.21 | 0.14 | 0.1 | 0.09 | 0.07 | 0.11 | 0.14 | 0.14 | 0.12 | 0.1 | 0.12 | 0.13 | 0.13 | 0.12 | 0.11 | 0.11 | 0.12 | 0.13 | 0.13 | 0.12 | 0.11 | 0.13 | 0.13 | 0.13 | 0.12 | 0.11 | 0.13 | 0.13 | 0.13 | 0.11 |
| PRE1_14 | 0.59 | 0.68 | 0.71 | 0.68 | 0.59 | 0.59 | 0.67 | 0.71 | 0.68 | 0.6 | 0.39 | 0.51 | 0.69 | 1 | 0.66 | 0.61 | 0.67 | 0.71 | 0.69 | 0.58 | 0.6 | 0.69 | 0.71 | 0.66 | 0.59 | 0.59 | 0.69 | 0.71 | 0.68 | 0.58 | 0.2 | 0.13 | 0.1 | 0.08 | 0.05 | 0.09 | 0.13 | 0.13 | 0.11 | 0.09 | 0.1 | 0.11 | 0.12 | 0.12 | 0.11 | 0.1 | 0.12 | 0.12 | 0.12 | 0.11 | 0.11 | 0.11 | 0.13 | 0.12 | 0.1 | 0.11 | 0.12 | 0.11 | 0.13 | 0.1 |
| PRE1_15 | 0.51 | 0.59 | 0.61 | 0.58 | 0.51 | 0.52 | 0.59 | 0.6 | 0.58 | 0.51 | 0.29 | 0.37 | 0.48 | 0.66 | 1 | 0.55 | 0.6 | 0.6 | 0.55 | 0.51 | 0.51 | 0.58 | 0.6 | 0.58 | 0.53 | 0.51 | 0.61 | 0.61 | 0.56 | 0.52 | 0.17 | 0.11 | 0.09 | 0.07 | 0.05 | 0.08 | 0.11 | 0.11 | 0.1 | 0.08 | 0.08 | 0.09 | 0.1 | 0.11 | 0.1 | 0.08 | 0.1 | 0.1 | 0.1 | 0.1 | 0.1 | 0.09 | 0.11 | 0.1 | 0.08 | 0.09 | 0.11 | 0.11 | 0.1 | 0.08 |
| PRE1_16 | 0.54 | 0.61 | 0.62 | 0.6 | 0.53 | 0.55 | 0.61 | 0.63 | 0.59 | 0.53 | 0.52 | 0.61 | 0.62 | 0.61 | 0.55 | 1 | 0.7 | 0.51 | 0.39 | 0.3 | 0.56 | 0.61 | 0.61 | 0.59 | 0.53 | 0.56 | 0.6 | 0.61 | 0.59 | 0.53 | 0.18 | 0.11 | 0.08 | 0.07 | 0.04 | 0.09 | 0.12 | 0.11 | 0.1 | 0.08 | 0.09 | 0.1 | 0.1 | 0.1 | 0.1 | 0.09 | 0.1 | 0.1 | 0.11 | 0.09 | 0.1 | 0.09 | 0.1 | 0.1 | 0.1 | 0.09 | 0.11 | 0.1 | 0.11 | 0.08 |
| PRE1_17 | 0.58 | 0.68 | 0.71 | 0.67 | 0.58 | 0.58 | 0.67 | 0.69 | 0.67 | 0.6 | 0.59 | 0.66 | 0.7 | 0.67 | 0.6 | 0.7 | 1 | 0.67 | 0.49 | 0.35 | 0.6 | 0.68 | 0.69 | 0.67 | 0.58 | 0.58 | 0.65 | 0.7 | 0.67 | 0.61 | 0.19 | 0.12 | 0.1 | 0.09 | 0.05 | 0.1 | 0.12 | 0.12 | 0.12 | 0.1 | 0.1 | 0.12 | 0.11 | 0.12 | 0.11 | 0.09 | 0.11 | 0.12 | 0.12 | 0.11 | 0.11 | 0.12 | 0.12 | 0.11 | 0.1 | 0.1 | 0.12 | 0.12 | 0.12 | 0.1 |
| PRE1_18 | 0.6 | 0.7 | 0.73 | 0.7 | 0.61 | 0.61 | 0.69 | 0.71 | 0.71 | 0.61 | 0.6 | 0.7 | 0.74 | 0.71 | 0.6 | 0.51 | 0.67 | 1 | 0.68 | 0.47 | 0.6 | 0.71 | 0.74 | 0.7 | 0.6 | 0.58 | 0.69 | 0.73 | 0.71 | 0.63 | 0.21 | 0.15 | 0.12 | 0.09 | 0.07 | 0.11 | 0.14 | 0.14 | 0.13 | 0.12 | 0.13 | 0.13 | 0.13 | 0.13 | 0.12 | 0.12 | 0.13 | 0.14 | 0.13 | 0.12 | 0.11 | 0.13 | 0.14 | 0.14 | 0.11 | 0.11 | 0.14 | 0.13 | 0.14 | 0.12 |
| PRE1_19 | 0.58 | 0.66 | 0.69 | 0.67 | 0.6 | 0.6 | 0.67 | 0.69 | 0.66 | 0.59 | 0.58 | 0.68 | 0.71 | 0.69 | 0.55 | 0.39 | 0.49 | 0.68 | 1 | 0.65 | 0.6 | 0.67 | 0.7 | 0.65 | 0.59 | 0.57 | 0.68 | 0.7 | 0.67 | 0.6 | 0.2 | 0.13 | 0.1 | 0.08 | 0.06 | 0.09 | 0.13 | 0.14 | 0.12 | 0.1 | 0.11 | 0.12 | 0.12 | 0.12 | 0.1 | 0.11 | 0.12 | 0.13 | 0.11 | 0.1 | 0.11 | 0.11 | 0.12 | 0.12 | 0.1 | 0.11 | 0.12 | 0.12 | 0.12 | 0.1 |
| PRE1_20 | 0.51 | 0.57 | 0.59 | 0.58 | 0.52 | 0.52 | 0.58 | 0.61 | 0.56 | 0.51 | 0.52 | 0.59 | 0.59 | 0.58 | 0.51 | 0.3 | 0.35 | 0.47 | 0.65 | 1 | 0.49 | 0.58 | 0.59 | 0.58 | 0.53 | 0.48 | 0.59 | 0.62 | 0.57 | 0.51 | 0.17 | 0.11 | 0.09 | 0.07 | 0.05 | 0.09 | 0.12 | 0.11 | 0.1 | 0.08 | 0.09 | 0.1 | 0.11 | 0.1 | 0.09 | 0.09 | 0.1 | 0.11 | 0.1 | 0.1 | 0.08 | 0.1 | 0.11 | 0.11 | 0.09 | 0.09 | 0.11 | 0.11 | 0.1 | 0.09 |
| PRE1_21 | 0.53 | 0.59 | 0.61 | 0.59 | 0.54 | 0.52 | 0.59 | 0.62 | 0.57 | 0.56 | 0.51 | 0.59 | 0.64 | 0.6 | 0.51 | 0.56 | 0.6 | 0.6 | 0.6 | 0.49 | 1 | 0.69 | 0.51 | 0.37 | 0.28 | 0.53 | 0.6 | 0.64 | 0.58 | 0.5 | 0.18 | 0.11 | 0.09 | 0.07 | 0.05 | 0.09 | 0.11 | 0.1 | 0.1 | 0.08 | 0.09 | 0.11 | 0.1 | 0.1 | 0.09 | 0.08 | 0.1 | 0.11 | 0.11 | 0.09 | 0.09 | 0.1 | 0.11 | 0.11 | 0.08 | 0.08 | 0.1 | 0.11 | 0.11 | 0.09 |
| PRE1_22 | 0.59 | 0.68 | 0.7 | 0.67 | 0.59 | 0.6 | 0.68 | 0.7 | 0.69 | 0.59 | 0.58 | 0.68 | 0.72 | 0.69 | 0.58 | 0.61 | 0.68 | 0.71 | 0.67 | 0.58 | 0.69 | 1 | 0.68 | 0.49 | 0.38 | 0.6 | 0.68 | 0.71 | 0.67 | 0.59 | 0.21 | 0.14 | 0.1 | 0.08 | 0.05 | 0.1 | 0.13 | 0.12 | 0.12 | 0.1 | 0.1 | 0.12 | 0.12 | 0.12 | 0.11 | 0.1 | 0.12 | 0.12 | 0.12 | 0.11 | 0.1 | 0.11 | 0.12 | 0.13 | 0.1 | 0.09 | 0.12 | 0.12 | 0.13 | 0.1 |
| PRE1_23 | 0.6 | 0.7 | 0.74 | 0.7 | 0.61 | 0.63 | 0.7 | 0.72 | 0.69 | 0.61 | 0.6 | 0.7 | 0.73 | 0.71 | 0.6 | 0.61 | 0.69 | 0.74 | 0.7 | 0.59 | 0.51 | 0.68 | 1 | 0.66 | 0.5 | 0.58 | 0.7 | 0.72 | 0.71 | 0.63 | 0.19 | 0.13 | 0.1 | 0.08 | 0.06 | 0.11 | 0.13 | 0.12 | 0.11 | 0.1 | 0.1 | 0.12 | 0.12 | 0.11 | 0.11 | 0.1 | 0.11 | 0.13 | 0.12 | 0.1 | 0.11 | 0.11 | 0.12 | 0.11 | 0.1 | 0.11 | 0.12 | 0.11 | 0.12 | 0.1 |
| PRE1_24 | 0.58 | 0.66 | 0.69 | 0.67 | 0.59 | 0.59 | 0.68 | 0.68 | 0.66 | 0.58 | 0.58 | 0.67 | 0.69 | 0.66 | 0.58 | 0.59 | 0.67 | 0.7 | 0.65 | 0.58 | 0.37 | 0.49 | 0.66 | 1 | 0.67 | 0.56 | 0.66 | 0.68 | 0.67 | 0.62 | 0.2 | 0.14 | 0.1 | 0.08 | 0.06 | 0.1 | 0.13 | 0.14 | 0.12 | 0.1 | 0.11 | 0.12 | 0.12 | 0.13 | 0.11 | 0.11 | 0.12 | 0.13 | 0.12 | 0.1 | 0.11 | 0.12 | 0.13 | 0.12 | 0.11 | 0.11 | 0.13 | 0.12 | 0.12 | 0.1 |
| PRE1_25 | 0.52 | 0.59 | 0.61 | 0.59 | 0.51 | 0.53 | 0.58 | 0.61 | 0.59 | 0.51 | 0.54 | 0.59 | 0.58 | 0.59 | 0.53 | 0.53 | 0.58 | 0.6 | 0.59 | 0.53 | 0.28 | 0.38 | 0.5 | 0.67 | 1 | 0.51 | 0.59 | 0.61 | 0.58 | 0.54 | 0.19 | 0.12 | 0.1 | 0.08 | 0.06 | 0.09 | 0.13 | 0.13 | 0.11 | 0.08 | 0.1 | 0.11 | 0.11 | 0.12 | 0.1 | 0.1 | 0.11 | 0.11 | 0.12 | 0.11 | 0.1 | 0.11 | 0.12 | 0.12 | 0.1 | 0.1 | 0.12 | 0.11 | 0.11 | 0.1 |
| PRE1_26 | 0.5 | 0.59 | 0.6 | 0.57 | 0.52 | 0.52 | 0.57 | 0.61 | 0.58 | 0.52 | 0.51 | 0.58 | 0.6 | 0.59 | 0.51 | 0.56 | 0.58 | 0.58 | 0.57 | 0.48 | 0.53 | 0.6 | 0.58 | 0.56 | 0.51 | 1 | 0.65 | 0.5 | 0.35 | 0.28 | 0.18 | 0.11 | 0.08 | 0.06 | 0.03 | 0.08 | 0.1 | 0.1 | 0.1 | 0.08 | 0.08 | 0.09 | 0.09 | 0.1 | 0.09 | 0.08 | 0.1 | 0.09 | 0.09 | 0.09 | 0.09 | 0.09 | 0.1 | 0.1 | 0.08 | 0.09 | 0.1 | 0.09 | 0.09 | 0.08 |
| PRE1_27 | 0.59 | 0.67 | 0.69 | 0.68 | 0.59 | 0.6 | 0.67 | 0.69 | 0.66 | 0.61 | 0.56 | 0.68 | 0.69 | 0.69 | 0.61 | 0.6 | 0.65 | 0.69 | 0.68 | 0.59 | 0.6 | 0.68 | 0.7 | 0.66 | 0.59 | 0.65 | 1 | 0.67 | 0.5 | 0.41 | 0.22 | 0.14 | 0.1 | 0.09 | 0.06 | 0.1 | 0.14 | 0.13 | 0.12 | 0.11 | 0.11 | 0.12 | 0.12 | 0.12 | 0.12 | 0.11 | 0.13 | 0.13 | 0.12 | 0.11 | 0.12 | 0.11 | 0.13 | 0.13 | 0.11 | 0.11 | 0.13 | 0.13 | 0.13 | 0.1 |
| PRE1_28 | 0.61 | 0.7 | 0.73 | 0.71 | 0.62 | 0.63 | 0.72 | 0.74 | 0.67 | 0.61 | 0.59 | 0.7 | 0.75 | 0.71 | 0.61 | 0.61 | 0.7 | 0.73 | 0.7 | 0.62 | 0.64 | 0.71 | 0.72 | 0.68 | 0.61 | 0.5 | 0.67 | 1 | 0.67 | 0.52 | 0.21 | 0.14 | 0.11 | 0.09 | 0.06 | 0.11 | 0.14 | 0.13 | 0.12 | 0.1 | 0.12 | 0.13 | 0.12 | 0.12 | 0.11 | 0.11 | 0.12 | 0.13 | 0.13 | 0.11 | 0.11 | 0.12 | 0.13 | 0.13 | 0.11 | 0.11 | 0.13 | 0.13 | 0.13 | 0.1 |
| PRE1_29 | 0.58 | 0.67 | 0.7 | 0.67 | 0.58 | 0.58 | 0.69 | 0.69 | 0.68 | 0.58 | 0.58 | 0.68 | 0.7 | 0.68 | 0.56 | 0.59 | 0.67 | 0.71 | 0.67 | 0.57 | 0.58 | 0.67 | 0.71 | 0.67 | 0.58 | 0.35 | 0.5 | 0.67 | 1 | 0.68 | 0.19 | 0.12 | 0.1 | 0.09 | 0.06 | 0.09 | 0.13 | 0.13 | 0.11 | 0.09 | 0.1 | 0.11 | 0.12 | 0.12 | 0.1 | 0.11 | 0.11 | 0.12 | 0.12 | 0.1 | 0.1 | 0.11 | 0.12 | 0.11 | 0.1 | 0.09 | 0.12 | 0.12 | 0.12 | 0.1 |
| PRE1_30 | 0.53 | 0.6 | 0.62 | 0.6 | 0.54 | 0.54 | 0.59 | 0.6 | 0.61 | 0.53 | 0.55 | 0.6 | 0.62 | 0.58 | 0.52 | 0.53 | 0.61 | 0.63 | 0.6 | 0.51 | 0.5 | 0.59 | 0.63 | 0.62 | 0.54 | 0.28 | 0.41 | 0.52 | 0.68 | 1 | 0.18 | 0.12 | 0.1 | 0.08 | 0.07 | 0.1 | 0.12 | 0.13 | 0.11 | 0.09 | 0.1 | 0.11 | 0.12 | 0.11 | 0.1 | 0.09 | 0.11 | 0.12 | 0.12 | 0.1 | 0.1 | 0.11 | 0.13 | 0.11 | 0.09 | 0.09 | 0.12 | 0.12 | 0.12 | 0.1 |
| POST1_1 | 0.34 | 0.23 | 0.17 | 0.13 | 0.1 | 0.18 | 0.2 | 0.2 | 0.2 | 0.18 | 0.18 | 0.21 | 0.21 | 0.2 | 0.17 | 0.18 | 0.19 | 0.21 | 0.2 | 0.17 | 0.18 | 0.21 | 0.19 | 0.2 | 0.19 | 0.18 | 0.22 | 0.21 | 0.19 | 0.18 | 1 | 0.66 | 0.48 | 0.36 | 0.28 | 0.49 | 0.58 | 0.59 | 0.58 | 0.52 | 0.51 | 0.56 | 0.59 | 0.58 | 0.53 | 0.49 | 0.59 | 0.61 | 0.58 | 0.5 | 0.51 | 0.59 | 0.59 | 0.57 | 0.51 | 0.51 | 0.59 | 0.6 | 0.57 | 0.51 |
| POST1_2 | 0.22 | 0.15 | 0.11 | 0.08 | 0.06 | 0.12 | 0.12 | 0.12 | 0.14 | 0.13 | 0.11 | 0.13 | 0.14 | 0.13 | 0.11 | 0.11 | 0.12 | 0.15 | 0.13 | 0.11 | 0.11 | 0.14 | 0.13 | 0.14 | 0.12 | 0.11 | 0.14 | 0.14 | 0.12 | 0.12 | 0.66 | 1 | 0.67 | 0.49 | 0.37 | 0.57 | 0.67 | 0.69 | 0.68 | 0.58 | 0.57 | 0.66 | 0.69 | 0.67 | 0.6 | 0.59 | 0.69 | 0.69 | 0.66 | 0.57 | 0.59 | 0.67 | 0.71 | 0.66 | 0.55 | 0.57 | 0.67 | 0.7 | 0.67 | 0.59 |
| POST1_3 | 0.16 | 0.11 | 0.09 | 0.06 | 0.07 | 0.08 | 0.09 | 0.09 | 0.12 | 0.1 | 0.09 | 0.1 | 0.1 | 0.1 | 0.09 | 0.08 | 0.1 | 0.12 | 0.1 | 0.09 | 0.09 | 0.1 | 0.1 | 0.1 | 0.1 | 0.08 | 0.1 | 0.11 | 0.1 | 0.1 | 0.48 | 0.67 | 1 | 0.68 | 0.48 | 0.58 | 0.7 | 0.72 | 0.7 | 0.61 | 0.6 | 0.7 | 0.72 | 0.7 | 0.6 | 0.6 | 0.71 | 0.73 | 0.69 | 0.59 | 0.61 | 0.7 | 0.74 | 0.69 | 0.58 | 0.6 | 0.7 | 0.73 | 0.69 | 0.61 |
| POST1_4 | 0.12 | 0.09 | 0.07 | 0.06 | 0.05 | 0.06 | 0.07 | 0.07 | 0.11 | 0.1 | 0.07 | 0.09 | 0.09 | 0.08 | 0.07 | 0.07 | 0.09 | 0.09 | 0.08 | 0.07 | 0.07 | 0.08 | 0.08 | 0.08 | 0.08 | 0.06 | 0.09 | 0.09 | 0.09 | 0.08 | 0.36 | 0.49 | 0.68 | 1 | 0.66 | 0.56 | 0.68 | 0.69 | 0.67 | 0.58 | 0.57 | 0.68 | 0.7 | 0.67 | 0.57 | 0.59 | 0.68 | 0.7 | 0.66 | 0.56 | 0.6 | 0.66 | 0.71 | 0.66 | 0.56 | 0.58 | 0.67 | 0.69 | 0.66 | 0.59 |
| POST1_5 | 0.09 | 0.07 | 0.05 | 0.04 | 0.03 | 0.04 | 0.04 | 0.05 | 0.08 | 0.06 | 0.04 | 0.06 | 0.07 | 0.05 | 0.05 | 0.04 | 0.05 | 0.07 | 0.06 | 0.05 | 0.05 | 0.05 | 0.06 | 0.06 | 0.06 | 0.03 | 0.06 | 0.06 | 0.06 | 0.07 | 0.28 | 0.37 | 0.48 | 0.66 | 1 | 0.51 | 0.58 | 0.6 | 0.58 | 0.51 | 0.51 | 0.58 | 0.6 | 0.58 | 0.51 | 0.52 | 0.59 | 0.59 | 0.58 | 0.51 | 0.53 | 0.58 | 0.6 | 0.57 | 0.5 | 0.5 | 0.57 | 0.59 | 0.59 | 0.54 |
| POST1_6 | 0.16 | 0.12 | 0.08 | 0.06 | 0.06 | 0.08 | 0.09 | 0.09 | 0.12 | 0.1 | 0.09 | 0.11 | 0.11 | 0.09 | 0.08 | 0.09 | 0.1 | 0.11 | 0.09 | 0.09 | 0.09 | 0.1 | 0.11 | 0.1 | 0.09 | 0.08 | 0.1 | 0.11 | 0.09 | 0.1 | 0.49 | 0.57 | 0.58 | 0.56 | 0.51 | 1 | 0.66 | 0.46 | 0.36 | 0.25 | 0.49 | 0.55 | 0.59 | 0.57 | 0.51 | 0.49 | 0.58 | 0.59 | 0.56 | 0.5 | 0.51 | 0.57 | 0.58 | 0.57 | 0.48 | 0.49 | 0.56 | 0.58 | 0.56 | 0.53 |
| POST1_7 | 0.2 | 0.14 | 0.11 | 0.08 | 0.08 | 0.11 | 0.12 | 0.12 | 0.14 | 0.13 | 0.1 | 0.14 | 0.14 | 0.13 | 0.11 | 0.12 | 0.12 | 0.14 | 0.13 | 0.12 | 0.11 | 0.13 | 0.13 | 0.13 | 0.13 | 0.1 | 0.14 | 0.14 | 0.13 | 0.12 | 0.58 | 0.67 | 0.7 | 0.68 | 0.58 | 0.66 | 1 | 0.68 | 0.5 | 0.38 | 0.58 | 0.67 | 0.7 | 0.68 | 0.57 | 0.56 | 0.69 | 0.71 | 0.68 | 0.58 | 0.6 | 0.69 | 0.71 | 0.66 | 0.56 | 0.58 | 0.67 | 0.71 | 0.68 | 0.59 |
| POST1_8 | 0.2 | 0.14 | 0.11 | 0.09 | 0.07 | 0.11 | 0.12 | 0.12 | 0.14 | 0.13 | 0.1 | 0.13 | 0.14 | 0.13 | 0.11 | 0.11 | 0.12 | 0.14 | 0.14 | 0.11 | 0.1 | 0.12 | 0.12 | 0.14 | 0.13 | 0.1 | 0.13 | 0.13 | 0.13 | 0.13 | 0.59 | 0.69 | 0.72 | 0.69 | 0.6 | 0.46 | 0.68 | 1 | 0.67 | 0.49 | 0.6 | 0.69 | 0.71 | 0.7 | 0.6 | 0.6 | 0.71 | 0.72 | 0.68 | 0.58 | 0.61 | 0.7 | 0.74 | 0.68 | 0.57 | 0.59 | 0.68 | 0.73 | 0.7 | 0.6 |
| POST1_9 | 0.2 | 0.13 | 0.1 | 0.08 | 0.05 | 0.1 | 0.1 | 0.11 | 0.13 | 0.12 | 0.1 | 0.12 | 0.12 | 0.11 | 0.1 | 0.1 | 0.12 | 0.13 | 0.12 | 0.1 | 0.1 | 0.12 | 0.11 | 0.12 | 0.11 | 0.1 | 0.12 | 0.12 | 0.11 | 0.11 | 0.58 | 0.68 | 0.7 | 0.67 | 0.58 | 0.36 | 0.5 | 0.67 | 1 | 0.67 | 0.57 | 0.67 | 0.7 | 0.67 | 0.6 | 0.61 | 0.68 | 0.7 | 0.66 | 0.56 | 0.6 | 0.67 | 0.71 | 0.68 | 0.56 | 0.58 | 0.67 | 0.7 | 0.66 | 0.6 |
| POST1_10 | 0.17 | 0.11 | 0.09 | 0.05 | 0.05 | 0.08 | 0.09 | 0.09 | 0.11 | 0.1 | 0.09 | 0.1 | 0.1 | 0.09 | 0.08 | 0.08 | 0.1 | 0.12 | 0.1 | 0.08 | 0.08 | 0.1 | 0.1 | 0.1 | 0.08 | 0.08 | 0.11 | 0.1 | 0.09 | 0.09 | 0.52 | 0.58 | 0.61 | 0.58 | 0.51 | 0.25 | 0.38 | 0.49 | 0.67 | 1 | 0.51 | 0.59 | 0.6 | 0.57 | 0.53 | 0.53 | 0.59 | 0.59 | 0.58 | 0.52 | 0.52 | 0.58 | 0.61 | 0.57 | 0.53 | 0.53 | 0.6 | 0.59 | 0.58 | 0.51 |
| POST1_11 | 0.18 | 0.12 | 0.08 | 0.07 | 0.05 | 0.09 | 0.09 | 0.1 | 0.12 | 0.11 | 0.09 | 0.11 | 0.12 | 0.1 | 0.08 | 0.09 | 0.1 | 0.13 | 0.11 | 0.09 | 0.09 | 0.1 | 0.1 | 0.11 | 0.1 | 0.08 | 0.11 | 0.12 | 0.1 | 0.1 | 0.51 | 0.57 | 0.6 | 0.57 | 0.51 | 0.49 | 0.58 | 0.6 | 0.57 | 0.51 | 1 | 0.65 | 0.46 | 0.37 | 0.28 | 0.49 | 0.58 | 0.62 | 0.57 | 0.5 | 0.52 | 0.59 | 0.61 | 0.56 | 0.49 | 0.51 | 0.57 | 0.6 | 0.57 | 0.52 |
| POST1_12 | 0.19 | 0.13 | 0.1 | 0.08 | 0.07 | 0.1 | 0.11 | 0.11 | 0.13 | 0.12 | 0.1 | 0.13 | 0.13 | 0.11 | 0.09 | 0.1 | 0.12 | 0.13 | 0.12 | 0.1 | 0.11 | 0.12 | 0.12 | 0.12 | 0.11 | 0.09 | 0.12 | 0.13 | 0.11 | 0.11 | 0.56 | 0.66 | 0.7 | 0.68 | 0.58 | 0.55 | 0.67 | 0.69 | 0.67 | 0.59 | 0.65 | 1 | 0.66 | 0.49 | 0.38 | 0.57 | 0.68 | 0.69 | 0.68 | 0.56 | 0.6 | 0.67 | 0.7 | 0.65 | 0.57 | 0.56 | 0.66 | 0.69 | 0.67 | 0.6 |
| POST1_13 | 0.19 | 0.13 | 0.1 | 0.08 | 0.07 | 0.1 | 0.11 | 0.11 | 0.13 | 0.12 | 0.1 | 0.12 | 0.13 | 0.12 | 0.1 | 0.1 | 0.11 | 0.13 | 0.12 | 0.11 | 0.1 | 0.12 | 0.12 | 0.12 | 0.11 | 0.09 | 0.12 | 0.12 | 0.12 | 0.12 | 0.59 | 0.69 | 0.72 | 0.7 | 0.6 | 0.59 | 0.7 | 0.71 | 0.7 | 0.6 | 0.46 | 0.66 | 1 | 0.68 | 0.5 | 0.61 | 0.69 | 0.71 | 0.68 | 0.59 | 0.61 | 0.69 | 0.72 | 0.69 | 0.59 | 0.59 | 0.69 | 0.73 | 0.68 | 0.6 |
| POST1_14 | 0.19 | 0.13 | 0.11 | 0.08 | 0.07 | 0.1 | 0.11 | 0.11 | 0.14 | 0.12 | 0.1 | 0.12 | 0.12 | 0.12 | 0.11 | 0.1 | 0.12 | 0.13 | 0.12 | 0.1 | 0.1 | 0.12 | 0.11 | 0.13 | 0.12 | 0.1 | 0.12 | 0.12 | 0.12 | 0.11 | 0.58 | 0.67 | 0.7 | 0.67 | 0.58 | 0.57 | 0.68 | 0.7 | 0.67 | 0.57 | 0.37 | 0.49 | 0.68 | 1 | 0.67 | 0.59 | 0.7 | 0.69 | 0.65 | 0.57 | 0.59 | 0.67 | 0.71 | 0.67 | 0.56 | 0.59 | 0.67 | 0.68 | 0.67 | 0.59 |
| POST1_15 | 0.18 | 0.13 | 0.1 | 0.06 | 0.05 | 0.09 | 0.11 | 0.11 | 0.12 | 0.1 | 0.09 | 0.11 | 0.11 | 0.11 | 0.1 | 0.1 | 0.11 | 0.12 | 0.1 | 0.09 | 0.09 | 0.11 | 0.11 | 0.11 | 0.1 | 0.09 | 0.12 | 0.11 | 0.1 | 0.1 | 0.53 | 0.6 | 0.6 | 0.57 | 0.51 | 0.51 | 0.57 | 0.6 | 0.6 | 0.53 | 0.28 | 0.38 | 0.5 | 0.67 | 1 | 0.52 | 0.61 | 0.6 | 0.57 | 0.52 | 0.53 | 0.6 | 0.61 | 0.58 | 0.49 | 0.51 | 0.6 | 0.61 | 0.58 | 0.52 |
| POST1_16 | 0.15 | 0.11 | 0.09 | 0.07 | 0.07 | 0.09 | 0.09 | 0.09 | 0.12 | 0.1 | 0.09 | 0.11 | 0.11 | 0.1 | 0.08 | 0.09 | 0.09 | 0.12 | 0.11 | 0.09 | 0.08 | 0.1 | 0.1 | 0.11 | 0.1 | 0.08 | 0.11 | 0.11 | 0.11 | 0.09 | 0.49 | 0.59 | 0.6 | 0.59 | 0.52 | 0.49 | 0.56 | 0.6 | 0.61 | 0.53 | 0.49 | 0.57 | 0.61 | 0.59 | 0.52 | 1 | 0.68 | 0.49 | 0.34 | 0.27 | 0.53 | 0.58 | 0.6 | 0.58 | 0.49 | 0.5 | 0.59 | 0.6 | 0.58 | 0.52 |
| POST1_17 | 0.19 | 0.14 | 0.11 | 0.07 | 0.06 | 0.1 | 0.11 | 0.11 | 0.13 | 0.11 | 0.1 | 0.12 | 0.12 | 0.12 | 0.1 | 0.1 | 0.11 | 0.13 | 0.12 | 0.1 | 0.1 | 0.12 | 0.11 | 0.12 | 0.11 | 0.1 | 0.13 | 0.12 | 0.11 | 0.11 | 0.59 | 0.69 | 0.71 | 0.68 | 0.59 | 0.58 | 0.69 | 0.71 | 0.68 | 0.59 | 0.58 | 0.68 | 0.69 | 0.7 | 0.61 | 0.68 | 1 | 0.69 | 0.51 | 0.37 | 0.61 | 0.68 | 0.72 | 0.68 | 0.56 | 0.59 | 0.68 | 0.72 | 0.68 | 0.59 |
| POST1_18 | 0.21 | 0.14 | 0.11 | 0.08 | 0.06 | 0.1 | 0.11 | 0.12 | 0.14 | 0.12 | 0.11 | 0.14 | 0.13 | 0.12 | 0.1 | 0.1 | 0.12 | 0.14 | 0.13 | 0.11 | 0.11 | 0.12 | 0.13 | 0.13 | 0.11 | 0.09 | 0.13 | 0.13 | 0.12 | 0.12 | 0.61 | 0.69 | 0.73 | 0.7 | 0.59 | 0.59 | 0.71 | 0.72 | 0.7 | 0.59 | 0.62 | 0.69 | 0.71 | 0.69 | 0.6 | 0.49 | 0.69 | 1 | 0.68 | 0.47 | 0.6 | 0.71 | 0.73 | 0.69 | 0.58 | 0.6 | 0.68 | 0.73 | 0.7 | 0.61 |
| POST1_19 | 0.2 | 0.14 | 0.1 | 0.08 | 0.06 | 0.1 | 0.11 | 0.11 | 0.13 | 0.13 | 0.1 | 0.12 | 0.13 | 0.12 | 0.1 | 0.11 | 0.12 | 0.13 | 0.11 | 0.1 | 0.11 | 0.12 | 0.12 | 0.12 | 0.12 | 0.09 | 0.12 | 0.13 | 0.12 | 0.12 | 0.58 | 0.66 | 0.69 | 0.66 | 0.58 | 0.56 | 0.68 | 0.68 | 0.66 | 0.58 | 0.57 | 0.68 | 0.68 | 0.65 | 0.57 | 0.34 | 0.51 | 0.68 | 1 | 0.63 | 0.58 | 0.67 | 0.7 | 0.64 | 0.57 | 0.58 | 0.67 | 0.68 | 0.65 | 0.58 |
| POST1_20 | 0.18 | 0.12 | 0.09 | 0.07 | 0.06 | 0.09 | 0.1 | 0.1 | 0.12 | 0.11 | 0.08 | 0.11 | 0.12 | 0.11 | 0.1 | 0.09 | 0.11 | 0.12 | 0.1 | 0.1 | 0.09 | 0.11 | 0.1 | 0.1 | 0.11 | 0.09 | 0.11 | 0.11 | 0.1 | 0.1 | 0.5 | 0.57 | 0.59 | 0.56 | 0.51 | 0.5 | 0.58 | 0.58 | 0.56 | 0.52 | 0.5 | 0.56 | 0.59 | 0.57 | 0.52 | 0.27 | 0.37 | 0.47 | 0.63 | 1 | 0.51 | 0.57 | 0.6 | 0.56 | 0.5 | 0.5 | 0.56 | 0.58 | 0.56 | 0.54 |
| POST1_21 | 0.17 | 0.12 | 0.09 | 0.07 | 0.06 | 0.09 | 0.1 | 0.1 | 0.12 | 0.11 | 0.09 | 0.11 | 0.11 | 0.11 | 0.1 | 0.1 | 0.11 | 0.11 | 0.11 | 0.08 | 0.09 | 0.1 | 0.11 | 0.11 | 0.1 | 0.09 | 0.12 | 0.11 | 0.1 | 0.1 | 0.51 | 0.59 | 0.61 | 0.6 | 0.53 | 0.51 | 0.6 | 0.61 | 0.6 | 0.52 | 0.52 | 0.6 | 0.61 | 0.59 | 0.53 | 0.53 | 0.61 | 0.6 | 0.58 | 0.51 | 1 | 0.68 | 0.51 | 0.36 | 0.26 | 0.52 | 0.58 | 0.6 | 0.58 | 0.55 |
| POST1_22 | 0.2 | 0.14 | 0.09 | 0.06 | 0.05 | 0.1 | 0.1 | 0.1 | 0.12 | 0.12 | 0.1 | 0.12 | 0.13 | 0.11 | 0.09 | 0.09 | 0.12 | 0.13 | 0.11 | 0.1 | 0.1 | 0.11 | 0.11 | 0.12 | 0.11 | 0.09 | 0.11 | 0.12 | 0.11 | 0.11 | 0.59 | 0.67 | 0.7 | 0.66 | 0.58 | 0.57 | 0.69 | 0.7 | 0.67 | 0.58 | 0.59 | 0.67 | 0.69 | 0.67 | 0.6 | 0.58 | 0.68 | 0.71 | 0.67 | 0.57 | 0.68 | 1 | 0.68 | 0.48 | 0.36 | 0.58 | 0.68 | 0.7 | 0.67 | 0.6 |
| POST1_23 | 0.2 | 0.14 | 0.11 | 0.08 | 0.07 | 0.11 | 0.11 | 0.12 | 0.14 | 0.12 | 0.1 | 0.13 | 0.13 | 0.13 | 0.11 | 0.1 | 0.12 | 0.14 | 0.12 | 0.11 | 0.11 | 0.12 | 0.12 | 0.13 | 0.12 | 0.1 | 0.13 | 0.13 | 0.12 | 0.13 | 0.59 | 0.71 | 0.74 | 0.71 | 0.6 | 0.58 | 0.71 | 0.74 | 0.71 | 0.61 | 0.61 | 0.7 | 0.72 | 0.71 | 0.61 | 0.6 | 0.72 | 0.73 | 0.7 | 0.6 | 0.51 | 0.68 | 1 | 0.68 | 0.46 | 0.6 | 0.71 | 0.75 | 0.7 | 0.6 |
| POST1_24 | 0.19 | 0.13 | 0.11 | 0.08 | 0.07 | 0.1 | 0.11 | 0.11 | 0.14 | 0.12 | 0.1 | 0.13 | 0.13 | 0.12 | 0.1 | 0.1 | 0.11 | 0.14 | 0.12 | 0.11 | 0.11 | 0.13 | 0.11 | 0.12 | 0.12 | 0.1 | 0.13 | 0.13 | 0.11 | 0.11 | 0.57 | 0.66 | 0.69 | 0.66 | 0.57 | 0.57 | 0.66 | 0.68 | 0.68 | 0.57 | 0.56 | 0.65 | 0.69 | 0.67 | 0.58 | 0.58 | 0.68 | 0.69 | 0.64 | 0.56 | 0.36 | 0.48 | 0.68 | 1 | 0.64 | 0.57 | 0.66 | 0.69 | 0.66 | 0.57 |
| POST1_25 | 0.17 | 0.12 | 0.09 | 0.06 | 0.06 | 0.09 | 0.1 | 0.1 | 0.11 | 0.11 | 0.09 | 0.12 | 0.12 | 0.1 | 0.08 | 0.1 | 0.1 | 0.11 | 0.1 | 0.09 | 0.08 | 0.1 | 0.1 | 0.11 | 0.1 | 0.08 | 0.11 | 0.11 | 0.1 | 0.09 | 0.51 | 0.55 | 0.58 | 0.56 | 0.5 | 0.48 | 0.56 | 0.57 | 0.56 | 0.53 | 0.49 | 0.57 | 0.59 | 0.56 | 0.49 | 0.49 | 0.56 | 0.58 | 0.57 | 0.5 | 0.26 | 0.36 | 0.46 | 0.64 | 1 | 0.49 | 0.55 | 0.57 | 0.56 | 0.53 |
| POST1_26 | 0.18 | 0.13 | 0.09 | 0.06 | 0.04 | 0.08 | 0.09 | 0.1 | 0.11 | 0.11 | 0.08 | 0.11 | 0.11 | 0.11 | 0.09 | 0.09 | 0.1 | 0.11 | 0.11 | 0.09 | 0.08 | 0.09 | 0.11 | 0.11 | 0.1 | 0.09 | 0.11 | 0.11 | 0.09 | 0.09 | 0.51 | 0.57 | 0.6 | 0.58 | 0.5 | 0.49 | 0.58 | 0.59 | 0.58 | 0.53 | 0.51 | 0.56 | 0.59 | 0.59 | 0.51 | 0.5 | 0.59 | 0.6 | 0.58 | 0.5 | 0.52 | 0.58 | 0.6 | 0.57 | 0.49 | 1 | 0.66 | 0.48 | 0.35 | 0.28 |
| POST1_27 | 0.2 | 0.14 | 0.11 | 0.08 | 0.07 | 0.1 | 0.12 | 0.12 | 0.14 | 0.12 | 0.11 | 0.13 | 0.13 | 0.12 | 0.11 | 0.11 | 0.12 | 0.14 | 0.12 | 0.11 | 0.1 | 0.12 | 0.12 | 0.13 | 0.12 | 0.1 | 0.13 | 0.13 | 0.12 | 0.12 | 0.59 | 0.67 | 0.7 | 0.67 | 0.57 | 0.56 | 0.67 | 0.68 | 0.67 | 0.6 | 0.57 | 0.66 | 0.69 | 0.67 | 0.6 | 0.59 | 0.68 | 0.68 | 0.67 | 0.56 | 0.58 | 0.68 | 0.71 | 0.66 | 0.55 | 0.66 | 1 | 0.68 | 0.47 | 0.39 |
| POST1_28 | 0.2 | 0.13 | 0.1 | 0.08 | 0.07 | 0.11 | 0.11 | 0.11 | 0.13 | 0.12 | 0.1 | 0.13 | 0.13 | 0.11 | 0.11 | 0.1 | 0.12 | 0.13 | 0.12 | 0.11 | 0.11 | 0.12 | 0.11 | 0.12 | 0.11 | 0.09 | 0.13 | 0.13 | 0.12 | 0.12 | 0.6 | 0.7 | 0.73 | 0.69 | 0.59 | 0.58 | 0.71 | 0.73 | 0.7 | 0.59 | 0.6 | 0.69 | 0.73 | 0.68 | 0.61 | 0.6 | 0.72 | 0.73 | 0.68 | 0.58 | 0.6 | 0.7 | 0.75 | 0.69 | 0.57 | 0.48 | 0.68 | 1 | 0.67 | 0.49 |
| POST1_29 | 0.19 | 0.13 | 0.11 | 0.08 | 0.07 | 0.11 | 0.11 | 0.11 | 0.14 | 0.12 | 0.1 | 0.12 | 0.13 | 0.13 | 0.1 | 0.11 | 0.12 | 0.14 | 0.12 | 0.1 | 0.11 | 0.13 | 0.12 | 0.12 | 0.11 | 0.09 | 0.13 | 0.13 | 0.12 | 0.12 | 0.57 | 0.67 | 0.69 | 0.66 | 0.59 | 0.56 | 0.68 | 0.7 | 0.66 | 0.58 | 0.57 | 0.67 | 0.68 | 0.67 | 0.58 | 0.58 | 0.68 | 0.7 | 0.65 | 0.56 | 0.58 | 0.67 | 0.7 | 0.66 | 0.56 | 0.35 | 0.47 | 0.67 | 1 | 0.67 |
| POST1_30 | 0.16 | 0.12 | 0.09 | 0.06 | 0.06 | 0.08 | 0.09 | 0.1 | 0.12 | 0.1 | 0.09 | 0.11 | 0.11 | 0.1 | 0.08 | 0.08 | 0.1 | 0.12 | 0.1 | 0.09 | 0.09 | 0.1 | 0.1 | 0.1 | 0.1 | 0.08 | 0.1 | 0.1 | 0.1 | 0.1 | 0.51 | 0.59 | 0.61 | 0.59 | 0.54 | 0.53 | 0.59 | 0.6 | 0.6 | 0.51 | 0.52 | 0.6 | 0.6 | 0.59 | 0.52 | 0.52 | 0.59 | 0.61 | 0.58 | 0.54 | 0.55 | 0.6 | 0.6 | 0.57 | 0.53 | 0.28 | 0.39 | 0.49 | 0.67 | 1 |
# mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP:
PRE_alpha = CronbachAlpha(PP_30.30[pre_30mzp])
POST_alpha = CronbachAlpha(PP_30.30[post_30mzp])
PP_30.30_Alpha = FisherZInv(mean(c(FisherZ(PRE_alpha), FisherZ(POST_alpha))))Korrelation zwischen den Pre- und Post-Intervall-Mittelwerten = 0.179.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Pre-MZP (Fisher-Z-transformiert): r = 0.65.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Post-MZP (Fisher-Z-transformiert): r = 0.64.
Mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP = 0.978.
Verteilungen der Pre-Post-(Mittelwerts-)Veränderungen
#hist(PP_5.5$MeanDiff, col = "lightblue1", main = paste0("Mittlere Pre-Post-Intervall-Differenz in PP_5.5 = ",
# round(mean(PP_5.5$MeanDiff), digits = 3)))
#hist(PP_30.30$MeanDiff, col = "lightblue1", main = paste0("Mittlere Pre-Post-Intervall-Differenz in PP_30.30 = ",
# round(mean(PP_30.30$MeanDiff), digits = 3)))
#hist(PP_1.1$Diff, col = "lightblue1", main = paste0("Mittlere Pre-Post-Differenz in PP_1.1 = ",
# round(mean(PP_1.1$Diff), digits = 3)))
temp = tibble(MeanDiffs = c(PP_5.5$MeanDiff, PP_30.30$MeanDiff, PP_1.1$Diff),
Datasets = rep(c("PP_5.5", "PP_30.30", "PP_1.1"), each = length(PP_5.5$MeanDiff)))
temp %>%
ggplot(aes(x = MeanDiffs, fill = Datasets)) +
geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
labs(title = "Pre-Post-Differences", x = "PHQ-9 Pre-Post-Difference")
scatter.hist(PP_1.1$Diff, PP_30.30$MeanDiff, xlab = "PP_1.1$Diff",
ylab = "PP_30.30$MeanDiff", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Korrelation zwischen den Pre-Post-Differenzen in PP_1.1 und PP_30.30 = 0.638.
Prozentuale Überlappung der Pre-Post-(Mittelwerts-)Veränderungen
# Overlap-Plots zum Vergleich
final.plot(list(PP_5.5_MeanDiff = PP_5.5$MeanDiff, PP_30.30_MeanDiff = PP_30.30$MeanDiff),
overlap(list(PP_5.5_MeanDiff = PP_5.5$MeanDiff, PP_30.30_MeanDiff = PP_30.30$MeanDiff))$OV)
final.plot(list(PP_5.5_MeanDiff = PP_5.5$MeanDiff, PP_1.1_Diff = PP_1.1$Diff),
overlap(list(PP_5.5_MeanDiff = PP_5.5$MeanDiff, PP_1.1_Diff = PP_1.1$Diff))$OV)
final.plot(list(PP_30.30_MeanDiff = PP_30.30$MeanDiff, PP_1.1_Diff = PP_1.1$Diff),
overlap(list(PP_30.30_MeanDiff = PP_30.30$MeanDiff, PP_1.1_Diff = PP_1.1$Diff))$OV)Cohen´s d (mit gepoolten SDs) vom Pre- zum Post-Intervall in den Original-Simulationsdaten (je 5 MZP)
\[ d = \frac{\overline{x_{1}} - \overline{x_{2}}} {\sqrt{0.5 \cdot (s_{x}^2 + s_{y}^2)}} \]
\(\overline{x_{1}}\) = mean of subject´s pretest scores, \(\overline{x_{2}}\) = mean of subject´s posttest scores, \(s_{x}\) = individual standard deviation of pretest time points, \(s_{y}\) = individual standard deviation of posttest time points
PP_5.5$Cohen_d = (PP_5.5$PRE_Mean - PP_5.5$POST_Mean) / sqrt(0.5 * (PP_5.5$ind.pretestSD^2 + PP_5.5$ind.posttestSD^2))
# Sollen Cohen_d %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_5.5 = PP_5.5 %>%
# within(., {Cohen_d[Cohen_d %in% c(-Inf,Inf)] = NA})
hist(PP_5.5$Cohen_d, col = "lightblue1", main = "PP_5.5$Cohen_d")
cohen_d_5.5 = (mean(PP_5.5$PRE_Mean) - mean(PP_5.5$POST_Mean)) / sqrt(0.5 * (mean(PP_5.5$ind.pretestSD)^2 +
mean(PP_5.5$ind.posttestSD)^2))
final.plot(list(PP_5.5_PRE_Mean = PP_5.5$PRE_Mean, PP_5.5_POST_Mean = PP_5.5$POST_Mean),
overlap(list(PP_5.5_PRE_Mean = PP_5.5$PRE_Mean, PP_5.5_POST_Mean = PP_5.5$POST_Mean))$OV)Gepoolte Varianz zwischen Pre- und Post-Intervall-Mittelwerten in PP_5.5 = 4.031.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten (für jede Person einzeln berechnet) in PP_5.5 = 1.697.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten in PP_5.5 = 1.416.
Cohen´s d (mit gepoolten SDs) vom Pre- zum Post-Intervall in den erweiterten Intervall-Daten (je 30 MZP)
PP_30.30$Cohen_d = (PP_30.30$PRE_Mean - PP_30.30$POST_Mean) / sqrt(0.5 * (PP_30.30$ind.pretestSD^2 +
PP_30.30$ind.posttestSD^2))
# Sollen Cohen_d %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_30.30 = PP_30.30 %>%
# within(., {Cohen_d[Cohen_d %in% c(-Inf,Inf)] = NA})
hist(PP_30.30$Cohen_d, col = "lightblue1", main = "PP_30.30$Cohen_d")
cohen_d_30.30 = (mean(PP_30.30$PRE_Mean) - mean(PP_30.30$POST_Mean)) / sqrt(0.5 * (mean(PP_30.30$ind.pretestSD)^2 + mean(PP_30.30$ind.posttestSD)^2))
final.plot(list(PP_30.30_PRE_Mean = PP_30.30$PRE_Mean, PP_30.30_POST_Mean = PP_30.30$POST_Mean),
overlap(list(PP_30.30_PRE_Mean = PP_30.30$PRE_Mean, PP_30.30_POST_Mean =
PP_30.30$POST_Mean))$OV)Gepoolte Varianz zwischen Pre- und Post-Intervall-Mittelwerten in PP_30.30 = 4.031.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten (für jede Person einzeln berechnet) in PP_30.30 = 1.866.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten in PP_30.30 = 1.556.
Cohen´s d (mit gepoolten SDs) vom Pre- zum Post-MZP in der Stichprobe mit je 1 MZP
\[ d = \frac{\overline{X_{1}} - \overline{X_{2}}} {\sqrt{0.5 \cdot (s_{X}^2 + s_{Y}^2)}} \]
\(\overline{X_{1}}\) = mean of pretest scores in the whole sample, \(\overline{X_{2}}\) = mean of posttest scores in the whole sample, \(s_{X}\) = standard deviation of pretest scores in the whole sample, \(s_{Y}\) = standard deviation of posttest scores in the whole sample
cohen_d_1.1 = (mean(PP_1.1$PRE) - mean(PP_1.1$POST)) / sqrt(0.5 * (sd(PP_1.1$PRE)^2 + sd(PP_1.1$POST)^2))
final.plot(list(PP_1.1_PRE = PP_1.1$PRE, PP_1.1_POST = PP_1.1$POST),
overlap(list(PP_1.1_PRE = PP_1.1$PRE, PP_1.1_POST = PP_1.1$POST))$OV)Gepoolte Varianz zwischen dem Pre- und Post-MZP in PP_1.1 = 5.074.
Durchschnittliches Cohen´s d zwischen dem Pre- und Post-MZP in PP_1.1 = 0.916.
PHQ_Int = tibble(PHQ_Score = c("0-4","5-9","10-14","15-19","20-27"),
Klassifikation = c(0,1,2,3,4),
Interpretation = c("Minimal or none","Mild","Moderate","Moderately severe","Severe"))PP_5.5 = PP_5.5 %>%
mutate(PRE_Mean_klass = case_when(
PRE_Mean <= 4 ~ 0,
PRE_Mean > 4 & PRE_Mean < 10 ~ 1,
PRE_Mean >= 10 & PRE_Mean < 15 ~ 2,
PRE_Mean >= 15 & PRE_Mean < 20 ~ 3,
PRE_Mean >= 20 ~ 4,
TRUE ~ PRE_Mean
)
)
temp = PP_5.5 %>%
dplyr::count(PRE_Mean_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
PHQ_Int %>%
dplyr::rename(PRE_Mean_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| PHQ_Score | PRE_Mean_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| 0-4 | 0 | Minimal or none | 3 | 0.04 |
| 5-9 | 1 | Mild | 3598 | 43.74 |
| 10-14 | 2 | Moderate | 4384 | 53.29 |
| 15-19 | 3 | Moderately severe | 241 | 2.93 |
| 20-27 | 4 | Severe | NA | NA |
PP_5.5 = PP_5.5 %>%
mutate(POST_Mean_klass = case_when(
POST_Mean <= 4 ~ 0,
POST_Mean > 4 & POST_Mean < 10 ~ 1,
POST_Mean >= 10 & POST_Mean < 15 ~ 2,
POST_Mean >= 15 & POST_Mean < 20 ~ 3,
POST_Mean >= 20 ~ 4,
TRUE ~ POST_Mean
)
)
temp = PP_5.5 %>%
dplyr::count(POST_Mean_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
PHQ_Int %>%
dplyr::rename(POST_Mean_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| PHQ_Score | POST_Mean_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| 0-4 | 0 | Minimal or none | 1691 | 20.56 |
| 5-9 | 1 | Mild | 4795 | 58.29 |
| 10-14 | 2 | Moderate | 1718 | 20.88 |
| 15-19 | 3 | Moderately severe | 22 | 0.27 |
| 20-27 | 4 | Severe | NA | NA |
temp = tibble(Klassifikation = c(PP_5.5$PRE_Mean_klass, PP_5.5$POST_Mean_klass),
MZP = rep(c("PRE_Mean_klass", "POST_Mean_klass"), each = length(PP_5.5$PRE_Mean_klass)))
temp %>%
ggplot(aes(x = Klassifikation, fill = MZP)) +
geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
labs(title = "PP_5.5: PHQ-9 Classification", x = "Classification")PP_30.30 = PP_30.30 %>%
mutate(PRE_Mean_klass = case_when(
PRE_Mean <= 4 ~ 0,
PRE_Mean > 4 & PRE_Mean < 10 ~ 1,
PRE_Mean >= 10 & PRE_Mean < 15 ~ 2,
PRE_Mean >= 15 & PRE_Mean < 20 ~ 3,
PRE_Mean >= 20 ~ 4,
TRUE ~ PRE_Mean
)
)
temp = PP_30.30 %>%
dplyr::count(PRE_Mean_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
PHQ_Int %>%
dplyr::rename(PRE_Mean_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| PHQ_Score | PRE_Mean_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| 0-4 | 0 | Minimal or none | 3 | 0.04 |
| 5-9 | 1 | Mild | 3598 | 43.74 |
| 10-14 | 2 | Moderate | 4384 | 53.29 |
| 15-19 | 3 | Moderately severe | 241 | 2.93 |
| 20-27 | 4 | Severe | NA | NA |
PP_30.30 = PP_30.30 %>%
mutate(POST_Mean_klass = case_when(
POST_Mean <= 4 ~ 0,
POST_Mean > 4 & POST_Mean < 10 ~ 1,
POST_Mean >= 10 & POST_Mean < 15 ~ 2,
POST_Mean >= 15 & POST_Mean < 20 ~ 3,
POST_Mean >= 20 ~ 4,
TRUE ~ POST_Mean
)
)
temp = PP_30.30 %>%
dplyr::count(POST_Mean_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
PHQ_Int %>%
dplyr::rename(POST_Mean_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| PHQ_Score | POST_Mean_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| 0-4 | 0 | Minimal or none | 1691 | 20.56 |
| 5-9 | 1 | Mild | 4795 | 58.29 |
| 10-14 | 2 | Moderate | 1718 | 20.88 |
| 15-19 | 3 | Moderately severe | 22 | 0.27 |
| 20-27 | 4 | Severe | NA | NA |
temp = tibble(Klassifikation = c(PP_30.30$PRE_Mean_klass, PP_30.30$POST_Mean_klass),
MZP = rep(c("PRE_Mean_klass", "POST_Mean_klass"), each = length(PP_30.30$PRE_Mean_klass)))
temp %>%
ggplot(aes(x = Klassifikation, fill = MZP)) +
geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
labs(title = "PP_30.30: PHQ-9 Classification", x = "Classification")PP_1.1 = PP_1.1 %>%
mutate(PRE_klass = case_when(
PRE <= 4 ~ 0,
PRE > 4 & PRE < 10 ~ 1,
PRE >= 10 & PRE < 15 ~ 2,
PRE >= 15 & PRE < 20 ~ 3,
PRE >= 20 ~ 4,
TRUE ~ as.numeric(PRE)
)
)
temp = PP_1.1 %>%
dplyr::count(PRE_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
PHQ_Int %>%
dplyr::rename(PRE_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| PHQ_Score | PRE_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| 0-4 | 0 | Minimal or none | 258 | 3.14 |
| 5-9 | 1 | Mild | 2992 | 36.37 |
| 10-14 | 2 | Moderate | 4303 | 52.31 |
| 15-19 | 3 | Moderately severe | 639 | 7.77 |
| 20-27 | 4 | Severe | 34 | 0.41 |
PP_1.1 = PP_1.1 %>%
mutate(POST_klass = case_when(
POST <= 4 ~ 0,
POST > 4 & POST < 10 ~ 1,
POST >= 10 & POST < 15 ~ 2,
POST >= 15 & POST < 20 ~ 3,
POST >= 20 ~ 4,
TRUE ~ as.numeric(POST)
)
)
temp = PP_1.1 %>%
dplyr::count(POST_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
PHQ_Int %>%
dplyr::rename(POST_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| PHQ_Score | POST_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| 0-4 | 0 | Minimal or none | 2495 | 30.33 |
| 5-9 | 1 | Mild | 3606 | 43.84 |
| 10-14 | 2 | Moderate | 1733 | 21.07 |
| 15-19 | 3 | Moderately severe | 382 | 4.64 |
| 20-27 | 4 | Severe | 10 | 0.12 |
temp = tibble(Klassifikation = c(PP_1.1$PRE_klass, PP_1.1$POST_klass),
MZP = rep(c("PRE_klass", "POST_klass"), each = length(PP_1.1$PRE_klass)))
temp %>%
ggplot(aes(x = Klassifikation, fill = MZP)) +
geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
labs(title = "PP_1.1: PHQ-9 Classification", x = "Classification")
\[
PC = \Bigl(1 - \frac{\overline{x_{2}}} {\overline{x_{1}}}\Bigr) \cdot 100
\]
\(\overline{x_{2}}\) = mean of subject´s posttest scores, \(\overline{x_{1}}\) = mean of subject´s pretest scores
Interpretation des Percentage Change:
PC_Int = tibble(PC = c("PC <= -50","-50 < PC <= -25","-25 < PC < 25","25 <= PC < 50","PC >= 50"),
Klassifikation = c(-2,-1,0,1,2),
Interpretation = c("starke Verschlechterung","Verschlechterung","keine Veränderung",
"Verbesserung","starke Verbesserung"))PP_5.5$Mean_PC = (1-(PP_5.5$POST_Mean / PP_5.5$PRE_Mean)) * 100
# Sollen Mean_PC %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_5.5 = PP_5.5 %>%
# within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})
PP_5.5 = PP_5.5 %>%
mutate(Mean_PC_klass = case_when(
Mean_PC <= -50 ~ -2,
Mean_PC > -50 & Mean_PC <= -25 ~ -1,
Mean_PC > -25 & Mean_PC < 25 ~ 0,
Mean_PC >= 25 & Mean_PC < 50 ~ 1,
Mean_PC >= 50 ~ 2,
TRUE ~ Mean_PC
)
)
temp = PP_5.5 %>%
dplyr::count(Mean_PC_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
PC_Int %>%
dplyr::rename(Mean_PC_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| PC | Mean_PC_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| PC <= -50 | -2 | starke Verschlechterung | 225 | 2.74 |
| -50 < PC <= -25 | -1 | Verschlechterung | 391 | 4.75 |
| -25 < PC < 25 | 0 | keine Veränderung | 2774 | 33.72 |
| 25 <= PC < 50 | 1 | Verbesserung | 2276 | 27.67 |
| PC >= 50 | 2 | starke Verbesserung | 2560 | 31.12 |
x = PP_5.5 %>%
within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})
y = PP_5.5 %>%
within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})
scatter.hist(x$PRE_Mean, y$Mean_PC, xlab = "PP_5.5$PRE_Mean", ylab = "PP_5.5$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Korrelation Mean Percentage Change (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = 0.375.
PP_30.30$Mean_PC = (1-(PP_30.30$POST_Mean / PP_30.30$PRE_Mean)) * 100
# Sollen Mean_PC %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_30.30 = PP_30.30 %>%
# within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})
PP_30.30 = PP_30.30 %>%
mutate(Mean_PC_klass = case_when(
Mean_PC <= -50 ~ -2,
Mean_PC > -50 & Mean_PC <= -25 ~ -1,
Mean_PC > -25 & Mean_PC < 25 ~ 0,
Mean_PC >= 25 & Mean_PC < 50 ~ 1,
Mean_PC >= 50 ~ 2,
TRUE ~ Mean_PC
)
)
temp = PP_30.30 %>%
dplyr::count(Mean_PC_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
PC_Int %>%
dplyr::rename(Mean_PC_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| PC | Mean_PC_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| PC <= -50 | -2 | starke Verschlechterung | 225 | 2.74 |
| -50 < PC <= -25 | -1 | Verschlechterung | 391 | 4.75 |
| -25 < PC < 25 | 0 | keine Veränderung | 2774 | 33.72 |
| 25 <= PC < 50 | 1 | Verbesserung | 2276 | 27.67 |
| PC >= 50 | 2 | starke Verbesserung | 2560 | 31.12 |
x = PP_30.30 %>%
within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})
y = PP_30.30 %>%
within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})
scatter.hist(x$PRE_Mean, y$Mean_PC, xlab = "PP_30.30$PRE_Mean", ylab = "PP_30.30$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Korrelation Mean Percentage Change (je 30 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = 0.375.
PP_1.1$PC = (1 - (PP_1.1$POST / PP_1.1$PRE)) * 100
# Sollen PC %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_1.1 = PP_1.1 %>%
# within(., {PC[PC %in% c(-Inf,Inf)] = NA})
PP_1.1 = PP_1.1 %>%
mutate(PC_klass = case_when(
PC <= -50 ~ -2,
PC > -50 & PC <= -25 ~ -1,
PC > -25 & PC < 25 ~ 0,
PC >= 25 & PC < 50 ~ 1,
PC >= 50 ~ 2,
TRUE ~ as.numeric(PC)
)
)
temp = PP_1.1 %>%
dplyr::count(PC_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
PC_Int %>%
dplyr::rename(PC_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| PC | PC_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| PC <= -50 | -2 | starke Verschlechterung | 175 | 2.13 |
| -50 < PC <= -25 | -1 | Verschlechterung | 624 | 7.59 |
| -25 < PC < 25 | 0 | keine Veränderung | 2684 | 32.63 |
| 25 <= PC < 50 | 1 | Verbesserung | 1810 | 22.00 |
| PC >= 50 | 2 | starke Verbesserung | 2933 | 35.66 |
x = PP_1.1 %>%
within(., {PC[PC %in% c(-Inf,Inf)] = NA})
y = PP_1.1 %>%
within(., {PC[PC %in% c(-Inf,Inf)] = NA})
scatter.hist(x$PRE, y$PC, xlab = "PP_1.1$PRE", ylab = "PP_1.1$PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Korrelation von Percentage Change (je 1 MZP) mit PHQ-Baseline (Pre-MZP) = 0.243.
x = PP_5.5 %>%
within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})
y = PP_30.30 %>%
within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})
z = PP_1.1 %>%
within(., {PC[PC %in% c(-Inf,Inf)] = NA})
scatter.hist(x$Mean_PC, y$Mean_PC, xlab = "PP_5.5$Mean_PC", ylab = "PP_30.30$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))
scatter.hist(y$Mean_PC, z$PC, xlab = "PP_30.30$Mean_PC", ylab = "PP_1.1$PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))
scatter.hist(x$Mean_PC, z$PC, xlab = "PP_5.5$Mean_PC", ylab = "PP_1.1$PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))
\[
RCI = \frac{x_{2} - x_{1}} {s_{diff}}
\]
\[ s_{diff} = \sqrt{2 \cdot (S_{E})^2} \]
\[ SE = s_{1} \cdot \sqrt{1 - r_{xx´}} \]
\[
\text{significance cutoff} = 1.96 \cdot s_{diff} = 1.96 \cdot \sqrt{2 \cdot (s_{1} \cdot \sqrt{1 - r_{xx´}})^2}
\]
\(x_{2}\) = subject´s posttest score, \(x_{1}\) = subject´s pretest score, \(s_{diff}\) = standard error of difference between test scores, \(SE\) = standard error of measurement, \(s_{1}\) = standard deviation of test scores at pretest, \(r_{xx´}\) = reliability of the measure, \(\text{significance cutoff}\) = (absolute) cutoff score for reliable change (95%-criterion)
PP_5.5_RCI_JT_Mean = (mean(PP_5.5$POST_Mean) - mean(PP_5.5$PRE_Mean)) / sqrt(2 * (sd(PP_5.5$PRE_Mean) * sqrt(1 - PP_5.5_Alpha)) ^ 2)
PP_30.30_RCI_JT_Mean = (mean(PP_30.30$POST_Mean) - mean(PP_30.30$PRE_Mean)) / sqrt(2 * (sd(PP_30.30$PRE_Mean) * sqrt(1 - PP_5.5_Alpha)) ^ 2)
PP_1.1_RCI_JT_Mean = (mean(PP_1.1$POST) - mean(PP_1.1$PRE)) / sqrt(2 * (sd(PP_1.1$PRE) * sqrt(1 -
PP_5.5_Alpha)) ^ 2)Durchschnittlicher RCI(JT) auf Stichproben-Ebene in PP_5.5 = -2.282.
Durchschnittlicher RCI(JT) auf Stichproben-Ebene in PP_30.30 = -2.282.
Durchschnittlicher RCI(JT) auf Stichproben-Ebene in PP_1.1 = -1.834.
RCI(JT) von einem Pre- zu einem Post-MZP (= original für jede Person individuell)
PP_1.1$RCI_JT = (PP_1.1$POST - PP_1.1$PRE) / sqrt(2 * (sd(PP_1.1$PRE) * sqrt(1 - PP_5.5_Alpha)) ^ 2)
RCI_JT_Cutoff = 1.96 * sqrt(2 * (sd(PP_1.1$PRE) * sqrt(1 - PP_5.5_Alpha)) ^ 2)
# Sollen RCI_JT %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_1.1 = PP_1.1 %>%
# within(., {RCI_JT[RCI_JT %in% c(-Inf,Inf)] = NA})
x = PP_1.1 %>%
within(., {RCI_JT[RCI_JT %in% c(-Inf,Inf)] = NA})
y = PP_1.1 %>%
within(., {RCI_JT[RCI_JT %in% c(-Inf,Inf)] = NA})
scatter.hist(x$PRE, y$RCI_JT, xlab = "PP_1.1$PRE", ylab = "PP_1.1$RCI_JT", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Korrelation RCI_JT (je 1 MZP) mit PHQ-Baseline (Pre-MZP) = -0.451.
RCI(JT)-Cutoff für reliable Veränderung auf Gruppenebene (je 1 MZP) = 3.511.
Zwischenschritt vom RCI(JT) zum RCI(ind): Der Zähler in der Formel wird durch die Intervall-Differenz (5MZP Pre - 5MZP Post) ausgetauscht:
\[
RCI_{Zwischenstufe} = \frac{\overline{x_{2}} - \overline{x_{1}}} {s_{diff}}
\]
\(\overline{x_{2}}\) = mean of subject´s posttest scores, \(\overline{x_{1}}\) = mean of subject´s pretest scores
PP_5.5$RCI_JT_ZwStufe = (PP_5.5$POST_Mean - PP_5.5$PRE_Mean) / sqrt(2 * (sd(PP_5.5$PRE1_1) * sqrt(1 - PP_5.5_Alpha)) ^ 2)
# Sollen RCI_JT_ZwStufe %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_5.5 = PP_5.5 %>%
# within(., {RCI_JT_ZwStufe[RCI_JT_ZwStufe %in% c(-Inf,Inf)] = NA})
x = PP_5.5 %>%
within(., {RCI_JT_ZwStufe[RCI_JT_ZwStufe %in% c(-Inf,Inf)] = NA})
y = PP_5.5 %>%
within(., {RCI_JT_ZwStufe[RCI_JT_ZwStufe %in% c(-Inf,Inf)] = NA})
scatter.hist(x$PRE_Mean, y$RCI_JT_ZwStufe, xlab = "PP_5.5$PRE_Mean", ylab = "PP_5.5$RCI_JT_ZwStufe", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Korrelation RCI_JT_ZwStufe (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.543.
\[
RCI_{ind,preSD} = \frac{\overline{x_{2}} - \overline{x_{1}}} {SE_{D,pre}}
\]
\[ SE_{D,pre} = \sqrt{2 \cdot (s_{x} \cdot (1 - r_{xy})^2)} \]
\[ \text{significance cutoff} = 1.96 \cdot SE_{D,pre} = 1.96 \cdot \sqrt{2 \cdot (s_{x} \cdot (1 - r_{xy})^2)} \]
\(\overline{x_{2}}\) = mean of subject´s posttest scores, \(\overline{x_{1}}\) = mean of subject´s pretest scores, \(SE_{D,pre}\) = standard error of difference between the test scores in the individual´s pre interval \(s_{x}\) = individual standard deviation of pretest time points, \(r_{xy}\) = reliability (internal consistency Cronbach´s \(\alpha\)) of the measure, \(\text{significance cutoff}\) = (absolute) cutoff score for reliable change (95%-criterion)
PP_5.5
PP_5.5$SEd_pre = sqrt(2 * (PP_5.5$ind.pretestSD * sqrt(1 - PP_5.5_Alpha)) ^ 2)
PP_5.5$RCI_ind_preSD = (PP_5.5$POST_Mean - PP_5.5$PRE_Mean) / PP_5.5$SEd_pre
PP_5.5$RCI_ind_preSD_Cutoff = 1.96 * PP_5.5$SEd_pre
# Sollen SEd_pre, RCI_ind_preSD und RCI_ind_preSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_5.5 = PP_5.5 %>%
# within(., {SEd_pre[SEd_pre %in% c(-Inf,Inf)] = NA
# RCI_ind_preSD[RCI_ind_preSD %in% c(-Inf,Inf)] = NA
# RCI_ind_preSD_Cutoff[RCI_ind_preSD_Cutoff %in% c(-Inf,Inf)] = NA})
scatter.hist(PP_5.5$PRE_Mean, PP_5.5$RCI_ind_preSD, xlab = "PP_5.5$PRE_Mean", ylab = "PP_5.5$RCI_ind_preSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in PP_5.5 = 2.248.
Korrelation RCI(ind) nur mit Pre-SD (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.432.
PP_30.30
PP_30.30$SEd_pre = sqrt(2 * (PP_30.30$ind.pretestSD * sqrt(1 - PP_5.5_Alpha)) ^ 2)
PP_30.30$RCI_ind_preSD = (PP_30.30$POST_Mean - PP_30.30$PRE_Mean) / PP_30.30$SEd_pre
PP_30.30$RCI_ind_preSD_Cutoff = 1.96 * PP_30.30$SEd_pre
# Sollen SEd_pre, RCI_ind_preSD und RCI_ind_preSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_30.30 = PP_30.30 %>%
# within(., {SEd_pre[SEd_pre %in% c(-Inf,Inf)] = NA
# RCI_ind_preSD[RCI_ind_preSD %in% c(-Inf,Inf)] = NA
# RCI_ind_preSD_Cutoff[RCI_ind_preSD_Cutoff %in% c(-Inf,Inf)] = NA})
scatter.hist(PP_30.30$PRE_Mean, PP_30.30$RCI_ind_preSD, xlab = "PP_30.30$PRE_Mean", ylab = "PP_30.30$RCI_ind_preSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in PP_30.30 = 2.045.
Korrelation RCI(ind) nur mit Pre-SD (je 30 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.432.
\[
RCI_{ind} = \frac{\overline{x_{2}} - \overline{x_{1}}} {SE_{D}}
\]
\[ SE_{D} = \sqrt{(s_{x}^2 + s_{y}^2) \cdot (1 - r_{xy})} \]
\[ \text{significance cutoff} = 1.96 \cdot SE_{D} = 1.96 \cdot \sqrt{(s_{x}^2 + s_{y}^2) \cdot (1 - r_{xy})} \]
\(\overline{x_{2}}\) = mean of subject´s posttest scores, \(\overline{x_{1}}\) = mean of subject´s pretest scores, \(SE_{D}\) = pooled standard error of difference between the test scores \(s_{x}\) = individual standard deviation of pretest time points, \(s_{y}\) = individual standard deviation of pretest time points, \(r_{xy}\) = reliability (internal consistency Cronbach´s \(\alpha\)) of the measure, \(\text{significance cutoff}\) = (absolute) cutoff score for reliable change (95%-criterion)
PP_5.5
PP_5.5$SEd_pooled = sqrt((PP_5.5$ind.pretestSD ^ 2 + PP_5.5$ind.posttestSD ^ 2) * (1 - PP_5.5_Alpha))
PP_5.5$RCI_ind_pooledSD = (PP_5.5$POST_Mean - PP_5.5$PRE_Mean) / PP_5.5$SEd_pooled
PP_5.5$RCI_ind_pooledSD_Cutoff = 1.96 * PP_5.5$SEd_pooled
# Sollen SEd_pooled, RCI_ind_pooledSD und RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_5.5 = PP_5.5 %>%
# within(., {SEd_pooled[SEd_pooled %in% c(-Inf,Inf)] = NA
# RCI_ind_pooledSD[RCI_ind_pooledSD %in% c(-Inf,Inf)] = NA
# RCI_ind_pooledSD_Cutoff[RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf)] = NA})
scatter.hist(PP_5.5$PRE_Mean, PP_5.5$RCI_ind_pooledSD, xlab = "PP_5.5$PRE_Mean", ylab = "PP_5.5$RCI_ind_pooledSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in PP_5.5 = 2.641.
Korrelation RCI(ind) mit pooled SDs (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.418.
PP_30.30
PP_30.30$SEd_pooled = sqrt((PP_30.30$ind.pretestSD ^ 2 + PP_30.30$ind.posttestSD ^ 2) * (1 - PP_5.5_Alpha))
PP_30.30$RCI_ind_pooledSD = (PP_30.30$POST_Mean - PP_30.30$PRE_Mean) / PP_30.30$SEd_pooled
PP_30.30$RCI_ind_pooledSD_Cutoff = 1.96 * PP_30.30$SEd_pooled
# Sollen SEd_pooled, RCI_ind_pooledSD und RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_30.30 = PP_30.30 %>%
# within(., {SEd_pooled[SEd_pooled %in% c(-Inf,Inf)] = NA
# RCI_ind_pooledSD[RCI_ind_pooledSD %in% c(-Inf,Inf)] = NA
# RCI_ind_pooledSD_Cutoff[RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf)] = NA})
scatter.hist(PP_30.30$PRE_Mean, PP_30.30$RCI_ind_pooledSD, xlab = "PP_30.30$PRE_Mean", ylab = "PP_30.30$RCI_ind_pooledSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in PP_30.30 = 2.403.
Korrelation RCI(ind) mit pooled SDs (je 30 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.418.
Vergleich des RCI(JT) in der Stichprobe mit je 1 MZP mit anderen RCIs (ind) in Intervall-Daten (je 5 MZP und je 30 MZP)
x = PP_5.5 %>%
within(., {RCI_ind_preSD[RCI_ind_preSD %in% c(-Inf,Inf)] = NA
RCI_ind_pooledSD[RCI_ind_pooledSD %in% c(-Inf,Inf)] = NA})
y = PP_30.30 %>%
within(., {RCI_ind_preSD[RCI_ind_preSD %in% c(-Inf,Inf)] = NA
RCI_ind_pooledSD[RCI_ind_pooledSD %in% c(-Inf,Inf)] = NA})
z = PP_1.1 %>%
within(., {RCI_JT[RCI_JT %in% c(-Inf,Inf)] = NA})
scatter.hist(x$RCI_ind_preSD, z$RCI_JT, xlab = "PP_5.5$RCI_ind_preSD", ylab = "PP_1.1$RCI_JT", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))
scatter.hist(y$RCI_ind_preSD, z$RCI_JT, xlab = "PP_30.30$RCI_ind_preSD", ylab = "PP_1.1$RCI_JT", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))
scatter.hist(x$RCI_ind_pooledSD, z$RCI_JT, xlab = "PP_5.5$RCI_ind_pooledSD", ylab = "PP_1.1$RCI_JT", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))
scatter.hist(y$RCI_ind_pooledSD, z$RCI_JT, xlab = "PP_30.30$RCI_ind_pooledSD", ylab = "PP_1.1$RCI_JT", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))RCI_Int = tibble(RCI = c("RCI < -1,96","-1,96 <= RCI <= 1,96","RCI > 1,96"),
Klassifikation = c(-1,0,1),
Interpretation = c("reliable Verbesserung","keine reliable Veränderung","reliable Verschlechterung"))PP_5.5: RCI(ind) nur mit Pre-SDs
PP_5.5 = PP_5.5 %>%
mutate(RCI_ind_preSD_klass = case_when(
RCI_ind_preSD < -1.96 ~ -1,
RCI_ind_preSD >= -1.96 & RCI_ind_preSD < 1.96 ~ 0,
RCI_ind_preSD > 1.96 ~ 1,
TRUE ~ RCI_ind_preSD
)
)
temp = PP_5.5 %>%
dplyr::count(RCI_ind_preSD_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
RCI_Int %>%
dplyr::rename(RCI_ind_preSD_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| RCI | RCI_ind_preSD_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| RCI < -1,96 | -1 | reliable Verbesserung | 4987 | 60.62 |
| -1,96 <= RCI <= 1,96 | 0 | keine reliable Veränderung | 2617 | 31.81 |
| RCI > 1,96 | 1 | reliable Verschlechterung | 622 | 7.56 |
PP_5.5: RCI(ind) mit pooled SDs
PP_5.5 = PP_5.5 %>%
mutate(RCI_ind_pooledSD_klass = case_when(
RCI_ind_pooledSD < -1.96 ~ -1,
RCI_ind_pooledSD >= -1.96 & RCI_ind_pooledSD < 1.96 ~ 0,
RCI_ind_pooledSD > 1.96 ~ 1,
TRUE ~ RCI_ind_pooledSD
)
)
temp = PP_5.5 %>%
dplyr::count(RCI_ind_pooledSD_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
RCI_Int %>%
dplyr::rename(RCI_ind_pooledSD_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| RCI | RCI_ind_pooledSD_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| RCI < -1,96 | -1 | reliable Verbesserung | 4633 | 56.32 |
| -1,96 <= RCI <= 1,96 | 0 | keine reliable Veränderung | 3192 | 38.80 |
| RCI > 1,96 | 1 | reliable Verschlechterung | 401 | 4.87 |
PP_30.30: RCI(ind) nur mit Pre-SDs
PP_30.30 = PP_30.30 %>%
mutate(RCI_ind_preSD_klass = case_when(
RCI_ind_preSD < -1.96 ~ -1,
RCI_ind_preSD >= -1.96 & RCI_ind_preSD < 1.96 ~ 0,
RCI_ind_preSD > 1.96 ~ 1,
TRUE ~ RCI_ind_preSD
)
)
temp = PP_30.30 %>%
dplyr::count(RCI_ind_preSD_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
RCI_Int %>%
dplyr::rename(RCI_ind_preSD_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| RCI | RCI_ind_preSD_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| RCI < -1,96 | -1 | reliable Verbesserung | 5160 | 62.73 |
| -1,96 <= RCI <= 1,96 | 0 | keine reliable Veränderung | 2385 | 28.99 |
| RCI > 1,96 | 1 | reliable Verschlechterung | 681 | 8.28 |
PP_30.30: RCI(ind) mit pooled SDs
PP_30.30 = PP_30.30 %>%
mutate(RCI_ind_pooledSD_klass = case_when(
RCI_ind_pooledSD < -1.96 ~ -1,
RCI_ind_pooledSD >= -1.96 & RCI_ind_pooledSD < 1.96 ~ 0,
RCI_ind_pooledSD > 1.96 ~ 1,
TRUE ~ RCI_ind_pooledSD
)
)
temp = PP_30.30 %>%
dplyr::count(RCI_ind_pooledSD_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
RCI_Int %>%
dplyr::rename(RCI_ind_pooledSD_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| RCI | RCI_ind_pooledSD_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| RCI < -1,96 | -1 | reliable Verbesserung | 4808 | 58.45 |
| -1,96 <= RCI <= 1,96 | 0 | keine reliable Veränderung | 2959 | 35.97 |
| RCI > 1,96 | 1 | reliable Verschlechterung | 459 | 5.58 |
PP_5.5: RCI(JT)-Zwischenstufe mit Pre-Mean - Post-Mean im Zähler.
PP_5.5 = PP_5.5 %>%
mutate(RCI_JT_ZwStufe_klass = case_when(
RCI_JT_ZwStufe < -1.96 ~ -1,
RCI_JT_ZwStufe >= -1.96 & RCI_JT_ZwStufe < 1.96 ~ 0,
RCI_JT_ZwStufe > 1.96 ~ 1,
TRUE ~ RCI_JT_ZwStufe
)
)
temp = PP_5.5 %>%
dplyr::count(RCI_JT_ZwStufe_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
RCI_Int %>%
dplyr::rename(RCI_JT_ZwStufe_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| RCI | RCI_JT_ZwStufe_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| RCI < -1,96 | -1 | reliable Verbesserung | 3951 | 48.03 |
| -1,96 <= RCI <= 1,96 | 0 | keine reliable Veränderung | 4007 | 48.71 |
| RCI > 1,96 | 1 | reliable Verschlechterung | 268 | 3.26 |
PP_1.1: RCI(JT)
PP_1.1 = PP_1.1 %>%
mutate(RCI_JT_klass = case_when(
RCI_JT < -1.96 ~ -1,
RCI_JT >= -1.96 & RCI_JT < 1.96 ~ 0,
RCI_JT > 1.96 ~ 1,
TRUE ~ RCI_JT
)
)
temp = PP_1.1 %>%
dplyr::count(RCI_JT_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
RCI_Int %>%
dplyr::rename(RCI_JT_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| RCI | RCI_JT_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| RCI < -1,96 | -1 | reliable Verbesserung | 3776 | 45.90 |
| -1,96 <= RCI <= 1,96 | 0 | keine reliable Veränderung | 4144 | 50.38 |
| RCI > 1,96 | 1 | reliable Verschlechterung | 306 | 3.72 |
\[
\bigl[ r_{xx} (X_{pre} - M_{pre}) + M_{pre} \bigr] \pm 2 \cdot S_{pre} \cdot \sqrt{1 - r_{xx}}
\]
\(r_{xx}\) = reliability of the measure, \(X_{pre}\) = individual´s raw score at pre-treatment, \(M_{pre}\) = mean of the sample at pre-treatment, \(S_{pre}\) = standard deviation of the sample at pre-treatment
Interpretation der Post-Ausprägung nach EN-Intervall-Methode
EN_Int = tibble(EN = c("PHQ POST < [EN-Intervall]","PHQ POST im [EN-Intervall]","PHQ POST > [EN-Intervall]"),
Klassifikation = c(-1,0,1), Interpretation = c("signifikante Verbesserung",
"keine signifikante Veränderung","signifikante Verschlechterung"))EN-Intervalle in PP_5.5
PP_5.5$EN_min = (PP_5.5_Alpha * (PP_5.5$PRE_Mean - mean(PP_5.5$PRE_Mean)) + mean(PP_5.5$PRE_Mean)) - 2 *
mean(PP_5.5$ind.pretestSD) * sqrt(1 - PP_5.5_Alpha)
PP_5.5$EN_max = (PP_5.5_Alpha * (PP_5.5$PRE_Mean - mean(PP_5.5$PRE_Mean)) + mean(PP_5.5$PRE_Mean)) + 2 *
mean(PP_5.5$ind.pretestSD) * sqrt(1 - PP_5.5_Alpha)
PP_5.5 = PP_5.5 %>%
mutate(EN_klass = case_when(
POST_Mean > EN_max ~ 1,
POST_Mean < EN_max & POST_Mean > EN_min ~ 0,
POST_Mean < EN_min ~ -1,
TRUE ~ POST_Mean
)
)
temp = PP_5.5 %>%
dplyr::count(EN_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
EN_Int %>%
dplyr::rename(EN_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| EN | EN_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| PHQ POST < [EN-Intervall] | -1 | signifikante Verbesserung | 5554 | 67.52 |
| PHQ POST im [EN-Intervall] | 0 | keine signifikante Veränderung | 1953 | 23.74 |
| PHQ POST > [EN-Intervall] | 1 | signifikante Verschlechterung | 719 | 8.74 |
EN-Intervalle in PP_30.30
PP_30.30$EN_min = (PP_5.5_Alpha * (PP_30.30$PRE_Mean - mean(PP_30.30$PRE_Mean)) + mean(PP_30.30$PRE_Mean)) - 2 * mean(PP_30.30$ind.pretestSD) * sqrt(1 - PP_5.5_Alpha)
PP_30.30$EN_max = (PP_5.5_Alpha * (PP_30.30$PRE_Mean - mean(PP_30.30$PRE_Mean)) + mean(PP_30.30$PRE_Mean)) + 2 * mean(PP_30.30$ind.pretestSD) * sqrt(1 - PP_5.5_Alpha)
PP_30.30 = PP_30.30 %>%
mutate(EN_klass = case_when(
POST_Mean > EN_max ~ 1,
POST_Mean < EN_max & POST_Mean > EN_min ~ 0,
POST_Mean < EN_min ~ -1,
TRUE ~ POST_Mean
)
)
temp = PP_30.30 %>%
dplyr::count(EN_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
EN_Int %>%
dplyr::rename(EN_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| EN | EN_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| PHQ POST < [EN-Intervall] | -1 | signifikante Verbesserung | 5665 | 68.87 |
| PHQ POST im [EN-Intervall] | 0 | keine signifikante Veränderung | 1776 | 21.59 |
| PHQ POST > [EN-Intervall] | 1 | signifikante Verschlechterung | 785 | 9.54 |
EN-Intervalle in PP_1.1
PP_1.1$EN_min = (PP_5.5_Alpha * (PP_1.1$PRE - mean(PP_1.1$PRE)) + mean(PP_1.1$PRE)) - 2 * sd(PP_1.1$PRE) * sqrt(1 - PP_5.5_Alpha)
PP_1.1$EN_max = (PP_5.5_Alpha * (PP_1.1$PRE - mean(PP_1.1$PRE)) + mean(PP_1.1$PRE)) + 2 * sd(PP_1.1$PRE) * sqrt(1 - PP_5.5_Alpha)
PP_1.1 = PP_1.1 %>%
mutate(EN_klass = case_when(
POST > EN_max ~ 1,
POST < EN_max & POST > EN_min ~ 0,
POST < EN_min ~ -1,
TRUE ~ as.numeric(POST)
)
)
temp = PP_1.1 %>%
dplyr::count(EN_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
EN_Int %>%
dplyr::rename(EN_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| EN | EN_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| PHQ POST < [EN-Intervall] | -1 | signifikante Verbesserung | 4568 | 55.53 |
| PHQ POST im [EN-Intervall] | 0 | keine signifikante Veränderung | 3090 | 37.56 |
| PHQ POST > [EN-Intervall] | 1 | signifikante Verschlechterung | 568 | 6.90 |
Clinically Significant Improvement (CSI) vom Pre- zum Post-Intervall
“The original validation study of the PHQ-9 defined clinically significant improvement as [a pre-treatment score >= 10 and] a post-treatment score of <= 9 combined with improvement of 50%.” (McMillan, Gilbody, & Richards, 2010)
CSI_Int = tibble(CSI = c("Pre-Score >= 10 & Post-Score <= 9 & PC >= 50", "every other combination",
"Pre-Score <= 9 & Post-Score >= 10 & PC <= -50"),
Klassifikation = c(-1,0,1),
Interpretation = c("klinisch signifikante Verbesserung", "keine klinisch signifikante Veränderung",
"klinisch signifikante Verschlechterung"))PP_5.5 = PP_5.5 %>%
mutate(CSI_klass = case_when(
PRE_Mean >= 10 & POST_Mean <= 9 & Mean_PC >= 50 ~ -1,
PRE_Mean <= 9 & POST_Mean >= 10 & Mean_PC <= -50 ~ 1,
TRUE ~ 0
)
)
temp = PP_5.5 %>%
dplyr::count(CSI_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
CSI_Int %>%
dplyr::rename(CSI_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| CSI | CSI_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| Pre-Score >= 10 & Post-Score <= 9 & PC >= 50 | -1 | klinisch signifikante Verbesserung | 1738 | 21.13 |
| every other combination | 0 | keine klinisch signifikante Veränderung | 6306 | 76.66 |
| Pre-Score <= 9 & Post-Score >= 10 & PC <= -50 | 1 | klinisch signifikante Verschlechterung | 182 | 2.21 |
PP_30.30 = PP_30.30 %>%
mutate(CSI_klass = case_when(
PRE_Mean >= 10 & POST_Mean <= 9 & Mean_PC >= 50 ~ -1,
PRE_Mean <= 9 & POST_Mean >= 10 & Mean_PC <= -50 ~ 1,
TRUE ~ 0
)
)
temp = PP_30.30 %>%
dplyr::count(CSI_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
CSI_Int %>%
dplyr::rename(CSI_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| CSI | CSI_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| Pre-Score >= 10 & Post-Score <= 9 & PC >= 50 | -1 | klinisch signifikante Verbesserung | 1738 | 21.13 |
| every other combination | 0 | keine klinisch signifikante Veränderung | 6306 | 76.66 |
| Pre-Score <= 9 & Post-Score >= 10 & PC <= -50 | 1 | klinisch signifikante Verschlechterung | 182 | 2.21 |
PP_1.1 = PP_1.1 %>%
mutate(CSI_klass = case_when(
PRE >= 10 & POST <= 9 & PC >= 50 ~ -1,
PRE <= 9 & POST >= 10 & PC <= -50 ~ 1,
TRUE ~ 0
)
)
temp = PP_1.1 %>%
dplyr::count(CSI_klass) %>%
mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))
CSI_Int %>%
dplyr::rename(CSI_klass = Klassifikation) %>%
full_join(., temp) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| CSI | CSI_klass | Interpretation | n | Percentage |
|---|---|---|---|---|
| Pre-Score >= 10 & Post-Score <= 9 & PC >= 50 | -1 | klinisch signifikante Verbesserung | 1989 | 24.18 |
| every other combination | 0 | keine klinisch signifikante Veränderung | 6179 | 75.12 |
| Pre-Score <= 9 & Post-Score >= 10 & PC <= -50 | 1 | klinisch signifikante Verschlechterung | 58 | 0.71 |
Übereinstimmung der Klassifikationen auf individueller Ebene zwischen PP_5.5, PP_30.30 und PP_1.1:
Interpretation von Cohen´s Kappa:
tibble(Cohen_Kappa = c("k < .20",".21 <= k < .40",".41 <= k < .60",".61 <= k < .80","k > .80"),
Interpretation = c("poor","fair","moderate","good","very good")) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| Cohen_Kappa | Interpretation |
|---|---|
| k < .20 | poor |
| .21 <= k < .40 | fair |
| .41 <= k < .60 | moderate |
| .61 <= k < .80 | good |
| k > .80 | very good |
Übereinstimmung zwischen den klinischen Interpretationen der PHQ-9-Werte für Pre- und Post-Intervalle (je 5 MZP und je 30 MZP) und für einzelne Pre- und Post-Messzeitpunkte (je 1 MZP):
# PRE
x = PP_5.5 %>%
select(ID, PRE_Mean_klass) %>%
dplyr::rename(PRE_klass.5 = PRE_Mean_klass)
y = PP_30.30 %>%
select(ID, PRE_Mean_klass) %>%
dplyr::rename(PRE_klass.30 = PRE_Mean_klass)
z = PP_1.1 %>%
select(ID, PRE_klass) %>%
dplyr::rename(PRE_klass.1 = PRE_klass)
temp = full_join(x, y, by = "ID") %>%
full_join(., z, by = "ID") %>%
select(-ID) %>%
mutate(across(.cols = everything(), as.factor))
### Cohen´s Kappa
rnames = c("PRE_klass_5.5", "PRE_klass_30.30", "PRE_klass_1.1")
Agreement = matrix(ncol = 3, nrow = 3, dimnames = list(rnames, rnames))
for (i in 1:nrow(Agreement)) {
for (j in 1:ncol(Agreement)) {
x = eval(parse(text = paste0("temp$", names(temp[,i]))))
y = eval(parse(text = paste0("temp$", names(temp[,j]))))
Agreement[i,j] = CohenKappa(x = x, y = y)
}
}
# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.7, cex = 0.8, las = 2,
key = list(cex.axis=0.7), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
title(main = "Übereinstimmung (Cohen´s Kappa) der PHQ-PRE-Klassifikationen")# POST
x = PP_5.5 %>%
select(ID, POST_Mean_klass) %>%
dplyr::rename(POST_klass.5 = POST_Mean_klass)
y = PP_30.30 %>%
select(ID, POST_Mean_klass) %>%
dplyr::rename(POST_klass.30 = POST_Mean_klass)
z = PP_1.1 %>%
select(ID, POST_klass) %>%
dplyr::rename(POST_klass.1 = POST_klass)
temp = full_join(x, y, by = "ID") %>%
full_join(., z, by = "ID") %>%
select(-ID) %>%
mutate(across(.cols = everything(), as.factor))
### Cohen´s Kappa
rnames = c("POST_klass_5.5", "POST_klass_30.30", "POST_klass_1.1")
Agreement = matrix(ncol = 3, nrow = 3, dimnames = list(rnames, rnames))
for (i in 1:nrow(Agreement)) {
for (j in 1:ncol(Agreement)) {
x = eval(parse(text = paste0("temp$", names(temp[,i]))))
y = eval(parse(text = paste0("temp$", names(temp[,j]))))
Agreement[i,j] = CohenKappa(x = x, y = y)
}
}
# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.7, cex = 0.8, las = 2,
key = list(cex.axis=0.7), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
title(main = "Übereinstimmung (Cohen´s Kappa) der PHQ-POST-Klassifikationen")# einheitliche Kodierung von Verbesserung (-1), keiner Veränderung (0) und Verschlechterung (1):
x = PP_5.5 %>%
select(ID, Mean_PC_klass, RCI_ind_preSD_klass, RCI_ind_pooledSD_klass, RCI_JT_ZwStufe_klass, EN_klass, CSI_klass) %>%
dplyr::rename(Mean_PC_5.5 = Mean_PC_klass, RCI_ind_preSD_5.5 = RCI_ind_preSD_klass, RCI_ind_pooledSD_5.5 = RCI_ind_pooledSD_klass,
RCI_JT_ZwStufe_5.5 = RCI_JT_ZwStufe_klass, EN_5.5 = EN_klass, CSI_5.5 = CSI_klass) %>%
mutate(Mean_PC_5.5 = recode(Mean_PC_5.5, '-2' = 1L, '-1' = 0L, '0' = 0L, '1' = 0L, '2' = -1L))
y = PP_30.30 %>%
select(ID, Mean_PC_klass, RCI_ind_preSD_klass, RCI_ind_pooledSD_klass, EN_klass, CSI_klass) %>%
dplyr::rename(Mean_PC_30.30 = Mean_PC_klass, RCI_ind_preSD_30.30 = RCI_ind_preSD_klass,
RCI_ind_pooledSD_30.30 = RCI_ind_pooledSD_klass, EN_30.30 = EN_klass, CSI_30.30 = CSI_klass) %>%
mutate(Mean_PC_30.30 = recode(Mean_PC_30.30, '-2' = 1L, '-1' = 0L, '0' = 0L, '1' = 0L, '2' = -1L))
z = PP_1.1 %>%
select(ID, PC_klass, RCI_JT_klass, EN_klass, CSI_klass) %>%
dplyr::rename(PC_1.1 = PC_klass, RCI_JT_1.1 = RCI_JT_klass,
EN_1.1 = EN_klass, CSI_1.1 = CSI_klass) %>%
mutate(PC_1.1 = recode(PC_1.1, '-2' = 1L, '-1' = 0L, '0' = 0L, '1' = 0L, '2' = -1L))
PP_Class = full_join(x, y, by = "ID") %>%
full_join(., z, "ID") %>%
select(-ID) %>%
dplyr::mutate(across(.cols = everything(), as.factor))
#save(PP_Class, file = "cor_07_k20/PP_Class.RData")
rnames = names(PP_Class)
#view(dfSummary(PP_Class))
#dfSummary(PP_Class, plain.ascii = FALSE, style = 'grid', graph.magnif = 0.75, valid.col = FALSE, tmp.img.dir = "/tmp")
#dfSummary(PP_Class)
print(dfSummary(PP_Class, varnumbers = FALSE, plain.ascii = FALSE, style = 'grid', graph.magnif = 0.75, valid.col = FALSE, na.col = FALSE, display.labels = FALSE, silent = FALSE, headers = FALSE, footnote = NA, tmp.img.dir = "/tmp"), method = 'render')| Variable | Stats / Values | Freqs (% of Valid) | Graph | ||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Mean_PC_5.5 [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| RCI_ind_preSD_5.5 [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| RCI_ind_pooledSD_5.5 [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| RCI_JT_ZwStufe_5.5 [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| EN_5.5 [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| CSI_5.5 [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| Mean_PC_30.30 [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| RCI_ind_preSD_30.30 [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| RCI_ind_pooledSD_30.30 [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| EN_30.30 [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| CSI_30.30 [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| PC_1.1 [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| RCI_JT_1.1 [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| EN_1.1 [factor] | 1. -1 2. 0 3. 1 |
|
|||||||||||||
| CSI_1.1 [factor] | 1. -1 2. 0 3. 1 |
|
Generated by summarytools 0.9.6 (R version 4.0.2)
2020-12-13
Gesamt-Übereinstimmung
### Cohen´s Kappa
Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))
for (i in 1:nrow(Agreement)) {
for (j in 1:ncol(Agreement)) {
x = eval(parse(text = paste0("PP_Class$", names(PP_Class[,i]))))
y = eval(parse(text = paste0("PP_Class$", names(PP_Class[,j]))))
Agreement[i,j] = CohenKappa(x = x, y = y)
}
}
# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2,
key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
title(main = "Übereinstimmung (Cohen´s Kappa) der Klassifikationen")### Prozentuale Übereinstimmung
Percentage_Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))
for (i in 1:nrow(Percentage_Agreement)) {
for (j in 1:ncol(Percentage_Agreement)) {
x = eval(parse(text = paste0("PP_Class$", names(PP_Class[,i]))))
y = eval(parse(text = paste0("PP_Class$", names(PP_Class[,j]))))
Percentage_Agreement[i,j] = Agree(cbind(x, y))[1]
}
}
# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Percentage_Agreement, col = heat.colors(n=4, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2,
key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.26, 0.51, 0.76, 1));
title(main = "Prozentuale Übereinstimmung der Klassifikationen")Übereinstimmung nur für Verbesserung (-1)
### Cohen´s Kappa
Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))
for (i in 1:nrow(Agreement)) {
for (j in 1:ncol(Agreement)) {
x = eval(parse(text = paste0("PP_Class$", names(PP_Class[,i])))) %>%
dplyr::recode_factor(., '-1' = -1L)
y = eval(parse(text = paste0("PP_Class$", names(PP_Class[,j])))) %>%
dplyr::recode_factor(., '-1' = -1L)
Agreement[i,j] = CohenKappa(x = x, y = y, useNA = "ifany")
}
}
# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2,
key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
title(main = "Übereinstimmung (Cohen´s Kappa): Verbesserung (-1)")### Prozentuale Übereinstimmung
Percentage_Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))
for (i in 1:nrow(Percentage_Agreement)) {
for (j in 1:ncol(Percentage_Agreement)) {
x = eval(parse(text = paste0("PP_Class$", names(PP_Class[,i]))))
y = eval(parse(text = paste0("PP_Class$", names(PP_Class[,j]))))
Percentage_Agreement[i,j] = length(which(x == -1L & y == -1L)) /
length(which(x == -1L | y == -1L))
}
}
# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Percentage_Agreement, col = heat.colors(n=4, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2,
key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.26, 0.51, 0.76, 1));
title(main = "Prozentuale Übereinstimmung: Verbesserung (-1)")Übereinstimmung nur für Verschlechterung (1)
### Cohen´s Kappa
Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))
for (i in 1:nrow(Agreement)) {
for (j in 1:ncol(Agreement)) {
x = eval(parse(text = paste0("PP_Class$", names(PP_Class[,i])))) %>%
recode_factor(., '1' = 1L)
y = eval(parse(text = paste0("PP_Class$", names(PP_Class[,j])))) %>%
recode_factor(., '1' = 1L)
Agreement[i,j] = CohenKappa(x = x, y = y, useNA = "ifany")
}
}
# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2,
key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
title(main = "Übereinstimmung (Cohen´s Kappa): Verschlechterung (1)")### Prozentuale Übereinstimmung
Percentage_Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))
for (i in 1:nrow(Percentage_Agreement)) {
for (j in 1:ncol(Percentage_Agreement)) {
x = eval(parse(text = paste0("PP_Class$", names(PP_Class[,i]))))
y = eval(parse(text = paste0("PP_Class$", names(PP_Class[,j]))))
Percentage_Agreement[i,j] = length(which(x == 1L & y == 1L)) /
length(which(x == 1L | y == 1L))
}
}
# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Percentage_Agreement, col = heat.colors(n=4, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2,
key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.26, 0.51, 0.76, 1));
title(main = "Prozentuale Übereinstimmung: Verschlechterung (1)")Diagnostische Sensitivität und Spezifität einer “neuen” Testmethode im Vergleich zu einer “Goldstandard”-Testmethode:
Sensitivität = Wahrscheinlichkeit für ein richtig-positives Testergebnis
Spezifität = Wahrscheinlichkeit für ein richtig-negatives Testergebnis
\[ Sensitivity = Recall = TPR = \frac{\sum{\text{True Positives}}} {\sum{\text{True Positives}} + \sum{\text{False Negatives}}} = \frac{tp}{tp + fn} \]
\[ Specificity = Selectivity = TNR = \frac{\sum{\text{True Negatives}}} {\sum{\text{True Negatives}} + \sum{\text{False Positives}}} = \frac{tn}{tn + fp} \]
\[ \textit{Geometric Mean of Sensitivity and Specificity} = \sqrt{Sensitivity \cdot Specificity} \]
\[ Sensitivity_{\textit{class-weighted average}} = Recall_{wgt} = \rho_{wgt} = \sum_{k=1}^{c} \frac{n_k}{n} \rho_k = \frac{1}{n} \sum_{k=1}^{c} tp^{(k)} = \frac{tp^{(deteriorated)}} {tp^{(deteriorated)} + fn^{(deteriorated)}} + \frac{tp^{(\textit{not changed})}} {tp^{(\textit{not changed})} + fn^{(\textit{not changed})}} + \frac{tp^{(improved)}} {tp^{(improved)} + fn^{(improved)}} \]
\(c\) = number of classes (i.e. 3: deteriorated; not changed; improved); \(n_k\) = number of cases belonging to class \(k\), with \(k=1,...,c\); \(n\) = total number of cases, with \(n = \sum_{k=1}^{c} n_k\)
Sensitivität & Spezifität gegenüber Veränderung:
Evaluation der Veränderungs-Klassifikationen der Klassifikationsmethoden im Vergleich zur klinischen Signifikanz CSI (je 30 MZP) als “Goldstandard”:
ClassEval = list()
for (i in 1:ncol(PP_Class)) {
x = eval(parse(text = paste0("PP_Class$", colnames(PP_Class[,i]))))
cm = confusionMatrix(x, reference = PP_Class$CSI_30.30,
dnn = c(paste0("PP_Class$", names(PP_Class[,i])), "CSI 30.30"), mode = "everything")
cm$agreement = cm$overall[c("Accuracy","Kappa")]
cm$senspez = cm$byClass %>%
as_tibble() %>%
select(Sensitivity, Specificity)
cm$senspez_cwa = cm$senspez %>%
summarise(across(.cols = everything(), .fns = geometric.mean, .names = "{.col}_cwa")) %>%
mutate(GMean_SenSpez = geometric.mean(c(Sensitivity_cwa, Specificity_cwa)))
ClassEval[[paste0(names(PP_Class[,i]))]] = cm[c("table","agreement","senspez","senspez_cwa")]
}
#save(ClassEval, file = "cor_07_k20/PP_ClassEval.RData")
#load("cor_07_k20/PP_Class.RData")
SenSpezSumm = tibble(Frequency = as.factor(c(rep("5.5", 6), rep("30.30", 5), rep("1.1", 4))),
Method = colnames(PP_Class),
Sens_imp = as.numeric(NA),
Sens_not = as.numeric(NA),
Sens_det = as.numeric(NA),
Spec_imp = as.numeric(NA),
Spec_not = as.numeric(NA),
Spec_det = as.numeric(NA),
Sensitivity_cwa = as.numeric(NA),
Specificity_cwa = as.numeric(NA),
SenSpec_mean = as.numeric(NA),
Accuracy_PercAgree = as.numeric(NA),
Kappa = as.numeric(NA))
for (i in 1:nrow(SenSpezSumm)) {
SenSpezSumm[i,"Sens_imp"] = ClassEval[[i]][["senspez"]]$Sensitivity[1]
SenSpezSumm[i,"Sens_not"] = ClassEval[[i]][["senspez"]]$Sensitivity[2]
SenSpezSumm[i,"Sens_det"] = ClassEval[[i]][["senspez"]]$Sensitivity[3]
SenSpezSumm[i,"Spec_imp"] = ClassEval[[i]][["senspez"]]$Specificity[1]
SenSpezSumm[i,"Spec_not"] = ClassEval[[i]][["senspez"]]$Specificity[2]
SenSpezSumm[i,"Spec_det"] = ClassEval[[i]][["senspez"]]$Specificity[3]
SenSpezSumm[i,"Sensitivity_cwa"] = ClassEval[[i]][["senspez_cwa"]]$Sensitivity_cwa
SenSpezSumm[i,"Specificity_cwa"] = ClassEval[[i]][["senspez_cwa"]]$Specificity_cwa
SenSpezSumm[i,"SenSpec_mean"] = ClassEval[[i]][["senspez_cwa"]]$GMean_SenSpez
SenSpezSumm[i,"Accuracy_PercAgree"] = ClassEval[[i]][["agreement"]][[1]]
SenSpezSumm[i,"Kappa"] = ClassEval[[i]][["agreement"]][[2]]
}
#save(SenSpezSumm, file = "cor_07_k20/PP_SenSpezSumm.RData")
#load("cor_07_k20/PP_SenSpezSumm.RData")
SenSpezSumm %>%
mutate(across(.cols = where(is.numeric), .fns = round, digits = 2)) %>%
kable() %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)| Frequency | Method | Sens_imp | Sens_not | Sens_det | Spec_imp | Spec_not | Spec_det | Sensitivity_cwa | Specificity_cwa | SenSpec_mean | Accuracy_PercAgree | Kappa |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 5.5 | Mean_PC_5.5 | 1.00 | 0.86 | 1.00 | 0.87 | 1.00 | 0.99 | 0.95 | 0.95 | 0.95 | 0.89 | 0.75 |
| 5.5 | RCI_ind_preSD_5.5 | 1.00 | 0.41 | 0.98 | 0.50 | 1.00 | 0.94 | 0.74 | 0.78 | 0.76 | 0.55 | 0.28 |
| 5.5 | RCI_ind_pooledSD_5.5 | 1.00 | 0.50 | 0.93 | 0.55 | 0.99 | 0.97 | 0.78 | 0.81 | 0.79 | 0.62 | 0.35 |
| 5.5 | RCI_JT_ZwStufe_5.5 | 1.00 | 0.63 | 0.97 | 0.66 | 1.00 | 0.99 | 0.85 | 0.87 | 0.86 | 0.72 | 0.46 |
| 5.5 | EN_5.5 | 1.00 | 0.31 | 1.00 | 0.41 | 1.00 | 0.93 | 0.68 | 0.73 | 0.70 | 0.47 | 0.21 |
| 5.5 | CSI_5.5 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 |
| 30.30 | Mean_PC_30.30 | 1.00 | 0.86 | 1.00 | 0.87 | 1.00 | 0.99 | 0.95 | 0.95 | 0.95 | 0.89 | 0.75 |
| 30.30 | RCI_ind_preSD_30.30 | 1.00 | 0.38 | 0.99 | 0.47 | 1.00 | 0.94 | 0.72 | 0.76 | 0.74 | 0.52 | 0.26 |
| 30.30 | RCI_ind_pooledSD_30.30 | 1.00 | 0.47 | 0.97 | 0.53 | 1.00 | 0.96 | 0.77 | 0.80 | 0.78 | 0.59 | 0.32 |
| 30.30 | EN_30.30 | 1.00 | 0.28 | 1.00 | 0.39 | 1.00 | 0.93 | 0.66 | 0.71 | 0.68 | 0.45 | 0.20 |
| 30.30 | CSI_30.30 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 | 1.00 |
| 1.1 | PC_1.1 | 0.71 | 0.71 | 0.09 | 0.74 | 0.66 | 0.98 | 0.35 | 0.78 | 0.53 | 0.69 | 0.32 |
| 1.1 | RCI_JT_1.1 | 0.85 | 0.59 | 0.13 | 0.65 | 0.79 | 0.96 | 0.40 | 0.79 | 0.56 | 0.64 | 0.30 |
| 1.1 | EN_1.1 | 0.90 | 0.44 | 0.20 | 0.54 | 0.84 | 0.93 | 0.43 | 0.75 | 0.57 | 0.54 | 0.22 |
| 1.1 | CSI_1.1 | 0.61 | 0.85 | 0.05 | 0.86 | 0.56 | 0.99 | 0.31 | 0.78 | 0.49 | 0.78 | 0.41 |
graphics::barplot(SenSpezSumm$Sensitivity_cwa ~ SenSpezSumm$Method, col = "dodgerblue", las = 2, cex.names = 0.7,
horiz = TRUE, main = "Sensitivity to Change (Reference = CSI_30.30)")
graphics::barplot(SenSpezSumm$Specificity_cwa ~ SenSpezSumm$Method, col = "dodgerblue", las = 2, cex.names = 0.7,
horiz = TRUE, main = "Specificity to Change (Reference = CSI_30.30)")
graphics::barplot(SenSpezSumm$SenSpec_mean ~ SenSpezSumm$Method, col = "dodgerblue", las = 2, cex.names = 0.7,
horiz = TRUE, main = "Mean of Sensitivity and Specificity (Reference = CSI_30.30)")
graphics::barplot(SenSpezSumm$Accuracy_PercAgree ~ SenSpezSumm$Method, col = "dodgerblue", las = 2, cex.names = 0.7,
horiz = TRUE, main = "Accuracy = Percentage Agreement (Reference = CSI_30.30)")
graphics::barplot(SenSpezSumm$Kappa ~ SenSpezSumm$Method, col = "dodgerblue", las = 2, cex.names = 0.7,
horiz = TRUE, main = "Agreement: Cohen´s Kappa (Reference = CSI_30.30)")Statt wenige zufällige MZP-Kombinationen zu ziehen und diese dann mit den “wahren” Schätzwerten und Klassifikationen (= berechnet anhand der gesamten Intervalle mit je 30 MZP) zu vergleichen, sollen die empirische Verteilung der Parameter und somit der Schätzfehler über Resampling-Methoden wie Jackknife-Verfahren und Bootstrapping berechnet werden.
Percentage Change (PC)
###### PP_5.5
n = 5
Mean_PC = function(x, ID_df) {(1-((mean(ID_df[x,2])) / (mean(ID_df[x,1])))) * 100}
for (i in 1:nrow(PP_5.5)) {
df = data.frame(PRE = as.numeric(PP_5.5[i,pre_5mzp]), POST = as.numeric(PP_5.5[i,post_5mzp]))
PP_5.5[i,"Mean_PC_jse"] = jackknife(1:n, Mean_PC, df)$jack.se
PP_5.5[i,"Mean_PC_jbias"] = jackknife(1:n, Mean_PC, df)$jack.bias
message(i)
}
PP_5.5_Mean_PC_JK = PP_5.5 %>%
select(ID, Mean_PC_jse, Mean_PC_jbias)
save(PP_5.5_Mean_PC_JK, file = "Jackknife/PP_5.5_Mean_PC_JK_k20.RData")
###### PP_30.30
n = 30
Mean_PC = function(x, ID_df) {(1-((mean(ID_df[x,2])) / (mean(ID_df[x,1])))) * 100}
for (i in 1:nrow(PP_30.30)) {
df = data.frame(PRE = as.numeric(PP_30.30[i,pre_30mzp]), POST = as.numeric(PP_30.30[i,post_30mzp]))
PP_30.30[i,"Mean_PC_jse"] = jackknife(1:n, Mean_PC, df)$jack.se
PP_30.30[i,"Mean_PC_jbias"] = jackknife(1:n, Mean_PC, df)$jack.bias
message(i)
}
PP_30.30_Mean_PC_JK = PP_30.30 %>%
select(ID, Mean_PC_jse, Mean_PC_jbias)
save(PP_30.30_Mean_PC_JK, file = "Jackknife/PP_30.30_Mean_PC_JK_k20.RData")load("Jackknife/PP_5.5_Mean_PC_JK_k20.RData")
load("Jackknife/PP_30.30_Mean_PC_JK_k20.RData")
PP_5.5 = full_join(PP_5.5, PP_5.5_Mean_PC_JK, by = "ID")
PP_30.30 = full_join(PP_30.30, PP_30.30_Mean_PC_JK, by = "ID")
temp = tibble(Jackknife_SE = c(PP_5.5$Mean_PC_jse, PP_30.30$Mean_PC_jse),
Datasets = rep(c("PP_5.5", "PP_30.30"), each = length(PP_5.5$Mean_PC_jse)))
temp %>%
ggplot(aes(x = Jackknife_SE, fill = Datasets)) +
geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
labs(x = "Jackknife SE of Mean Percentage Change", y = "Cases")#ggplot(temp, aes(x = Datasets, y = Jackknife_SE)) +
# geom_boxplot(na.rm = TRUE) +
# ggtitle("Jackknife SEs") +
# xlab("Dataset")
temp = tibble(Jackknife_Bias = c(PP_5.5$Mean_PC_jbias, PP_30.30$Mean_PC_jbias),
Datasets = rep(c("PP_5.5", "PP_30.30"), each = length(PP_5.5$Mean_PC_jbias)))
temp %>%
ggplot(aes(x = Jackknife_Bias, fill = Datasets)) +
geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
labs(x = "Jackknife Bias of Mean Percentage Change", y = "Cases")#ggplot(temp, aes(x = Datasets, y = Jackknife_Bias)) +
# geom_boxplot(na.rm = TRUE) +
# ggtitle("Jackknife Biases") +
# xlab("Dataset")RCI(ind) nur mit SD aus dem individuellen Pre-Intervall
###### PP_5.5
n = 5
RCI_ind_preSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) /
sqrt(2 * (sd(ID_df[x,1]) * sqrt(1 - PP_5.5_Alpha))^2)}
for (i in 1:nrow(PP_5.5)) {
df = data.frame(PRE = as.numeric(PP_5.5[i,pre_5mzp]), POST = as.numeric(PP_5.5[i,post_5mzp]))
PP_5.5[i,"RCI_ind_preSD_jse"] = jackknife(1:n, RCI_ind_preSD, df)$jack.se
PP_5.5[i,"RCI_ind_preSD_jbias"] = jackknife(1:n, RCI_ind_preSD, df)$jack.bias
message(i)
}
PP_5.5_RCI_ind_preSD_JK = PP_5.5 %>%
select(ID, RCI_ind_preSD_jse, RCI_ind_preSD_jbias)
save(PP_5.5_RCI_ind_preSD_JK, file = "Jackknife/PP_5.5_RCI_ind_preSD_JK_k20.RData")
###### PP_30.30
n = 30
RCI_ind_preSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) /
sqrt(2 * (sd(ID_df[x,1]) * sqrt(1 - PP_5.5_Alpha))^2)}
for (i in 1:nrow(PP_30.30)) {
df = data.frame(PRE = as.numeric(PP_30.30[i,pre_30mzp]), POST = as.numeric(PP_30.30[i,post_30mzp]))
PP_30.30[i,"RCI_ind_preSD_jse"] = jackknife(1:n, RCI_ind_preSD, df)$jack.se
PP_30.30[i,"RCI_ind_preSD_jbias"] = jackknife(1:n, RCI_ind_preSD, df)$jack.bias
message(i)
}
PP_30.30_RCI_ind_preSD_JK = PP_30.30 %>%
select(ID, RCI_ind_preSD_jse, RCI_ind_preSD_jbias)
save(PP_30.30_RCI_ind_preSD_JK, file = "Jackknife/PP_30.30_RCI_ind_preSD_JK_k20.RData")load("Jackknife/PP_5.5_RCI_ind_preSD_JK_k20.RData")
load("Jackknife/PP_30.30_RCI_ind_preSD_JK_k20.RData")
PP_5.5 = full_join(PP_5.5, PP_5.5_RCI_ind_preSD_JK, by = "ID")
PP_30.30 = full_join(PP_30.30, PP_30.30_RCI_ind_preSD_JK, by = "ID")
temp = tibble(Jackknife_SE = c(PP_5.5$RCI_ind_preSD_jse, PP_30.30$RCI_ind_preSD_jse),
Datasets = rep(c("PP_5.5", "PP_30.30"), each = length(PP_5.5$RCI_ind_preSD_jse)))
temp %>%
ggplot(aes(x = Jackknife_SE, fill = Datasets)) +
geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
labs(x = "Jackknife SE of RCI(ind) With Pre-SDs", y = "Cases")#ggplot(temp, aes(x = Datasets, y = Jackknife_SE)) +
# geom_boxplot(na.rm = TRUE) +
# ggtitle("Jackknife SEs") +
# xlab("Dataset")
temp = tibble(Jackknife_Bias = c(PP_5.5$RCI_ind_preSD_jbias, PP_30.30$RCI_ind_preSD_jbias),
Datasets = rep(c("PP_5.5", "PP_30.30"), each = length(PP_5.5$RCI_ind_preSD_jbias)))
temp %>%
ggplot(aes(x = Jackknife_Bias, fill = Datasets)) +
geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
labs(x = "Jackknife Bias of RCI(ind) With Pre-SDs", y = "Cases")#ggplot(temp, aes(x = Datasets, y = Jackknife_Bias)) +
# geom_boxplot(na.rm = TRUE) +
# ggtitle("Jackknife Biases") +
# xlab("Dataset")RCI(ind) mit pooled SDs aus beiden individuellen Intervallen
###### PP_5.5
n = 5
RCI_ind_pooledSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) /
sqrt((sd(ID_df[x,1])^ 2 + sd(ID_df[x,2])^ 2) * (1 - PP_5.5_Alpha))}
for (i in 1:nrow(PP_5.5)) {
df = data.frame(PRE = as.numeric(PP_5.5[i,pre_5mzp]), POST = as.numeric(PP_5.5[i,post_5mzp]))
PP_5.5[i,"RCI_ind_pooledSD_jse"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.se
PP_5.5[i,"RCI_ind_pooledSD_jbias"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.bias
message(i)
}
PP_5.5_RCI_ind_pooledSD_JK = PP_5.5 %>%
select(ID, RCI_ind_pooledSD_jse, RCI_ind_pooledSD_jbias)
save(PP_5.5_RCI_ind_pooledSD_JK, file = "Jackknife/PP_5.5_RCI_ind_pooledSD_JK_k20.RData")
###### PP_30.30
n = 30
RCI_ind_pooledSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) /
sqrt((sd(ID_df[x,1])^ 2 + sd(ID_df[x,2])^ 2) * (1 - PP_5.5_Alpha))}
for (i in 1:nrow(PP_30.30)) {
df = data.frame(PRE = as.numeric(PP_30.30[i,pre_30mzp]), POST = as.numeric(PP_30.30[i,post_30mzp]))
PP_30.30[i,"RCI_ind_pooledSD_jse"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.se
PP_30.30[i,"RCI_ind_pooledSD_jbias"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.bias
message(i)
}
PP_30.30_RCI_ind_pooledSD_JK = PP_30.30 %>%
select(ID, RCI_ind_pooledSD_jse, RCI_ind_pooledSD_jbias)
save(PP_30.30_RCI_ind_pooledSD_JK, file = "Jackknife/PP_30.30_RCI_ind_pooledSD_JK_k20.RData")load("Jackknife/PP_5.5_RCI_ind_pooledSD_JK_k20.RData")
load("Jackknife/PP_30.30_RCI_ind_pooledSD_JK_k20.RData")
PP_5.5 = full_join(PP_5.5, PP_5.5_RCI_ind_pooledSD_JK, by = "ID")
PP_30.30 = full_join(PP_30.30, PP_30.30_RCI_ind_pooledSD_JK, by = "ID")
temp = tibble(Jackknife_SE = c(PP_5.5$RCI_ind_pooledSD_jse, PP_30.30$RCI_ind_pooledSD_jse),
Datasets = rep(c("PP_5.5", "PP_30.30"), each = length(PP_5.5$RCI_ind_pooledSD_jse)))
temp %>%
ggplot(aes(x = Jackknife_SE, fill = Datasets)) +
geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
labs(x = "Jackknife SE of RCI(ind) With Pooled SDs", y = "Cases")#ggplot(temp, aes(x = Datasets, y = Jackknife_SE)) +
# geom_boxplot(na.rm = TRUE) +
# ggtitle("Jackknife SEs") +
# xlab("Dataset")
temp = tibble(Jackknife_Bias = c(PP_5.5$RCI_ind_pooledSD_jbias, PP_30.30$RCI_ind_pooledSD_jbias),
Datasets = rep(c("PP_5.5", "PP_30.30"), each = length(PP_5.5$RCI_ind_pooledSD_jbias)))
temp %>%
ggplot(aes(x = Jackknife_Bias, fill = Datasets)) +
geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
labs(x = "Jackknife Bias of RCI(ind) With Pooled SDs", y = "Cases")#ggplot(temp, aes(x = Datasets, y = Jackknife_Bias)) +
# geom_boxplot(na.rm = TRUE) +
# ggtitle("Jackknife Biases") +
# xlab("Dataset")